使用当前目录检索数据而不打开Excel工作簿（智能select性导入w / VBA）

（Excel 2010）我试图从各种“目标”工作簿中的不同但相似的文件夹中抓住特定的行。 我发现，当源代码（“LM”，代码正在执行的工作簿以及我想要将数据提取到的目标）和目标工作簿位于同一个文件夹中时，我无法打开目标工作簿，但是当他们在不同的地点（因为他们将在实践中），我收到一个“下标超出范围”的错误

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

线。 我努力了：

• 使用path名，dirname和文件名等的每个变体和组合作为后者Workbooks（）的参数。 我也有MsgBox我的片断和整个path名和文件名看，这是没有错误的。

• replace后面的工作簿（文件名）与工作簿variables（让我们称之为Targ），如LM（工作正常）

• 用ChDir和ChDrive改变path（＆我已经确认CurDir（）实际上是运行时的目标目录）并且执行上述操作

• 使用ThisWorkbook而不是LM进行通话

• 基本上每一个上述想法的排列

这是一个简洁的（因为机密的东西在那里）版本的代码（这工作正常，如果我解雇Workbooks.Open和Workbooks.Close，但我想要一个更有效的方法，因为这是一个繁忙的networking和人民这些文件一直在进出。事实上，我可以做到这一点，而无需打开文件，如果他们在同一个文件夹告诉我，我正在… …）

 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