Использование текущего каталога для извлечения данных без открытия книги Excel (интеллектуальный выборочный импорт с VBA)

(Excel 2010) Я пытаюсь получить определенные строки из множества «целевых» книг в разных, но похожих папках. Я обнаружил, что могу извлекать эти данные, когда исходная («LM», рабочая книга, в которой выполняется код, и в которую я хочу извлечь данные) и целевые рабочие книги находятся в одной папке, не открывая целевую рабочую книгу. , но когда они находятся в разных местах (как это будет на практике), я получаю сообщение об ошибке «Нижний индекс вне диапазона» для

LM.Worksheets("Sheet1").Range("B" & i + 1 & ":G" & i + 1).Value = _
          Workbooks(filename).Worksheets("Sheet1").Range("B6:G6").Value

линия. Я пытался:

  • Использование каждого варианта и комбинации имени пути, имени каталога и имени файла и т. д. в качестве аргумента для последних Workbooks(). У меня также был MsgBox для просмотра частей и полного имени пути и имени файла, которые не содержат ошибок.

  • Замена последних рабочих книг (имя файла) на переменную рабочей книги (давайте назовем ее Targ), например LM (которая отлично работает)

  • Изменение пути с помощью ChDir и ChDrive (и я подтвердил, что CurDir() на самом деле является целевым каталогом, когда он работает) и выполнение вышеуказанного

  • Использование ThisWorkbook вместо LM для вызова

  • В основном каждая перестановка вышеперечисленных идей

Вот урезанная (потому что там была конфиденциальная информация) версия кода (которая отлично работает, если я раскомментирую Workbooks.Open и Workbooks.Close, но мне нужен более эффективный метод, так как это загруженная сеть и люди находятся в этих файлах все время. Тот факт, что я могу сделать это, не открывая файлы, если они находятся в одной папке, говорит мне, что я что-то напутал...)

Sub Import()
    Dim directory As String, fileName As String, LM As Workbook, i as Integer
    Set LM = Workbooks("LM.xlsm")

    i = 1

    Dim DirArray As Variant

    'this is the array that handles the variations on the path, doesn't seem to be the problem
    DirArray = LM.Worksheets("Sheet2").Range("DirTable")

    Do While i <= UBound(DirArray)

       directory = DirArray(i, 1)

       dirname = "C:\blahblahblah"
       fileName = Dir(dirname & "*.xl??")
       pathname = dirname & fileName

       ChDir dirname
       ' Workbooks.Open (dirname & fileName)

       LM.Worksheets("Sheet1").Range("B" & i + 1 & ":G" & i + 1).Value = _
             Workbooks(filename).Worksheets("Sheet1").Range("B6:G6").Value

        i = i + 1

    '  Workbooks(fileName).Close

    Loop
End Sub

Если бы я только мог понять, что отличается, когда они находятся в одной папке! Навигация с ChDir и ChDrive, похоже, не приносит никакой пользы...


path excel vba directory chdir
person basaltanglia    schedule 27.05.2016    source источник
comment
Каким образом? Назначив промежуточную переменную? Не знаю, как это поможет...   -  person basaltanglia    schedule 27.05.2016
comment
Inter = Workbooks(pathname).Worksheets("Metrics").Range("B6:G6").Value LM.Worksheets("Sheet2").Range("B" & i + 1 & ":G" & i + 1).Value = Inter Отладчик помечает первую строку, такое же сообщение об ошибке   -  person basaltanglia    schedule 27.05.2016
comment
Workbooks(filename) когда вы это делаете, я думаю, вам нужен весь путь.   -  person findwindow    schedule 27.05.2016
comment
Я пробовал Workbooks(pathname), Workbooks(dirname & filename), Workbooks(dirname & "\" & filename) И другие варианты. И когда у меня msgbox или отладчик возвращают переменные, все они выглядят так, как я и ожидал...   -  person basaltanglia    schedule 27.05.2016
comment
А как насчет Workbooks(pathname & "\" & filename)? debug.print чтобы убедиться, что это правильно.   -  person findwindow    schedule 27.05.2016
comment
если вы посмотрите выше, имя пути уже содержит имя файла. Это было бы излишним и неточным.   -  person basaltanglia    schedule 27.05.2016
comment
Ах, моя вина. Так может вам просто нужно "\"? Опять же, что говорит debug.print? Это правильно??   -  person findwindow    schedule 27.05.2016
comment
Да, я просто использовал путь в качестве аргумента для Workbooks() и debug.print, и он выглядит правильно в окне отладки, но все равно выдает ошибку Subscript.   -  person basaltanglia    schedule 27.05.2016
comment
Тогда этой книги не существует. Или что-то, чего я не знаю.   -  person findwindow    schedule 27.05.2016
comment
Определенно существует. Определенно работает, когда они находятся в одной папке, или я сначала открываю книгу. Черт. Но спасибо за попытку.   -  person basaltanglia    schedule 27.05.2016
comment
Этот синтаксис работает только с открытыми книгами, независимо от того, находятся ли они в той же папке, что и файл макроса, или нет...   -  person Tim Williams    schedule 27.05.2016
comment
Ахахахахаха Тим прав... как всегда.   -  person findwindow    schedule 27.05.2016
comment
Да, следуя идее Тима, я буду создавать объекты для книг, которые вы хотите открыть. Немного больше кода, но должно быть безупречно. Редактировать: э-э, без ошибок, не безупречно XD   -  person findwindow    schedule 27.05.2016
comment
Вы пытались использовать SQL, чтобы получить требуемый диапазон? Посмотрите на использование ADO с Excel.   -  person Nathan_Sav    schedule 27.05.2016

Ответы (1)


arrow_upward
1
arrow_downward

Неясно, что именно вы хотите сделать, но это должна быть рабочая версия вашего опубликованного кода.

В папке только один файл Excel? Вы хотели использовать directory вместо жестко заданного DIRNAME?

Sub Import()

    Const DIRNAME As String = "C:\blahblahblah\"
    Dim directory As String, fileName As String, LM As Workbook, i As Integer
    Dim DirArray As Variant, wb As Workbook

    Set LM = Workbooks("LM.xlsm") 'ThisWorkbook ?
    DirArray = LM.Worksheets("Sheet2").Range("DirTable").Value

    For i = 1 To UBound(DirArray, 1)

        directory = DirArray(i, 1) 'what are these values ?

        fileName = Dir(DIRNAME & "*.xl??")

        If fileName <> "" Then

            'ChDir dirname '<< you do not need this if you pass the full path to Open...
            Set wb = Workbooks.Open(filename:=DIRNAME & fileName, _
                                    ReadOnly:=True, UpdateLinks:=0)

            LM.Worksheets("Sheet1").Range("B" & (i + 1) & ":G" & (i + 1)).Value = _
                       wb.Worksheets("Sheet1").Range("B6:G6").Value

            wb.Close False 'no save

        End If
     Next
End Sub
person Tim Williams    schedule 27.05.2016
comment
Хорошо, есть вероятность (упс), что я не закрыл целевую книгу в первый раз, поэтому, возможно, мне приходилось каждый раз открывать файл, чтобы использовать этот синтаксис. Значит, нет возможности получить данные, не открывая файл полностью? Есть ли хотя бы способ подавить все параметры диалога (например, ссылки только для чтения и обновления? У меня проблемы с использованием их в качестве необязательных аргументов в Workbooks.Open) - person basaltanglia; 27.05.2016