使用當前目錄在不打開 Excel 工作簿的情況下檢索數據（使用 VBA 的智能選擇性導入）

Question

（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 導航似乎沒有任何好處......

Answer 1

目前尚不清楚您到底想做什么，但這應該是您發布的代碼的工作版本。

每個文件夾只有一個 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