VBA列表文件夹中的Excel文件？

我有一个像这样的驱动器上的目录： 

G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017

在这个导演中，我有一系列的文件夹，像这样： 

 KW1 KW2 KW3 ETC.

在这里输入图像说明

接下来，在每周文件夹里我有一个供应商文件夹列表： 

 G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW1

在这里输入图像说明

每个供应商文件夹的平均内容如下所示：

在这里输入图像说明

为了便于参考，我只关心每个供应商文件夹中的excel文件。

下一个：

我有一个像这样的电子表格：

在这里输入图像说明

请注意工作簿中的文件目录指向： 

 G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW1

这应该查看该目录中的每个供应商文件夹，并列出每个文件中的所有excel文件和单元格c15中包含的电子邮件地址。

它没有列出每个文件的电子邮件地址。

我不断收到这个错误：

在这里输入图像说明

在这一行上： 

 values(r, 1) = ExecuteExcel4Macro(arg)

有时候，如果我input一个不同的目录，这个代码有效，指向wk 9或8.但是这些文件夹在外观上是相同的，都包含pdf和excel文件。

这是我的代码： 

 Sub SO() If Range("I8").Value = "" Then Exit Sub Else Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False '//Set your file path Dim parentFolder As String parentFolder = Range("I8").Value '// change as required, keep trailing slash If Dir(parentFolder) = "" Then parentFolder = Range("I8").Value & "\" '// change as required, keep trailing slash Else parentFolder = Range("I8").Value End If '//Fetch Results Dim results As String results = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & "*.xls*"" /S /B /A:-D").StdOut.ReadAll Debug.Print results 'On Error GoTo errHandler2 '// uncomment to dump results into column A of spreadsheet instead: Range("G17").Resize(UBound(Split(results, vbCrLf)), 1).Value = WorksheetFunction.Transpose(Split(results, vbCrLf)) Range("AD17").Resize(UBound(Split(results, vbCrLf)), 1).Value = "Remove" Range("V17").Resize(UBound(Split(results, vbCrLf)), 1).Value = " " '//----------------------------------------------------------------- '// uncomment to filter certain files from results. '// Const filterType As String = "*.exe" '// Dim filterResults As String '// '// filterResults = Join(Filter(Split(results, vbCrLf), filterType), vbCrLf) '// '// Debug.Print filterResults 'On Error GoTo errHandler Dim app As New Excel.Application app.Visible = False 'Visible is False by default, so this isn't necessary Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False '//Email copy code Dim startCell As Range, fileRng As Range Dim files As Variant, values() As Variant, values2() As Variant Dim path As String, file As String, arg As String Dim r As Long, i As Long 'Acquire the names of your files With ThisWorkbook.Worksheets(1) 'amend to your sheet name Set startCell = .Range("G17") 'amend to start cell of file names Set fileRng = .Range(startCell, .Cells(.Rows.Count, startCell.Column).End(xlUp)) End With files = fileRng.Value2 'Size your output array ReDim values(1 To UBound(files, 1), 1 To 1) 'Populate output array with values from workbooks For r = 1 To UBound(files, 1) 'Create argument to read workbook value i = InStrRev(files(r, 1), "\") path = Left(files(r, 1), i) file = Right(files(r, 1), Len(files(r, 1)) - i) arg = "'" & path & "[" & file & "]Sheet1'!R15C3" 'Acquire the value values(r, 1) = ExecuteExcel4Macro(arg) Next 'Write values to sheet fileRng.Offset(, 16).Value = values '// end email copy code errHandler: Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End If Exit Sub errHandler2: MsgBox "Could not locate folder directory." Exit Sub End Sub

请有人告诉我我要去哪里错了吗？

编辑：

我刚才知道了 如果文件夹或文件名包含一个撇号，它有什么关系。

还有一些与获取文件名的代码部分有关 

 'Populate output array with values from workbooks For r = 1 To UBound(files, 1) 'Create argument to read workbook value i = InStrRev(files(r, 1), "\") path = Left(files(r, 1), i) file = Right(files(r, 1), Len(files(r, 1)) - i) arg = "'" & path & "[" & file & "]Sheet1'!R15C3" 'Acquire the value values(r, 1) = ExecuteExcel4Macro(arg)

有没有办法来解决这个问题？

EDIT2：

使用@ASH提供的代码

当我debugging和打印错误，它看起来像这样。

在这里输入图像说明

没有错误正在打印

编辑3

在即时窗口查看后，我看到以下debugging打印错误值：

在这里输入图像说明

编辑4：

使用更新后的代码forms@AsH这些是在即时窗口中生成的唯一错误： 

 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Magners GB Ltd\AM Magners KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Magners GB Ltd\Magners KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Magners GB Ltd\CONF AM Magners KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Burts Potato Crisps Ltd\Burts KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Burts Potato Crisps Ltd\CONTACT Burts Potato Crisps Ltd KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\High 5\High 5 KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\High 5\AM2 High 5 KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\PhD Nutrition\PHD KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\PhD Nutrition\AM PHD KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Meastsnacks Group\Meatsnacks KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\USN\USN KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\General Mills UK\General Mills KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Bon Bon Buddies\Bon Bon Buddies KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Bon Bon Buddies\AM Bon Bon Buddies KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Bon Bon Buddies\CONF AM Bon Bon Buddies KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Symington's Ltd\CONF Symingtons KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Symington's Ltd\Symingtons KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Copernus\Copernus KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Dale Farm\Dale Farm KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Tayto Group Ltd\Tayto Group KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Tayto Group Ltd\CONF Tayto Group KW10.17.xlsx '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Magners GB Ltd\AM Magners KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Magners GB Ltd\Magners KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Magners GB Ltd\CONF AM Magners KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Burts Potato Crisps Ltd\Burts KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Burts Potato Crisps Ltd\CONTACT Burts Potato Crisps Ltd KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\High 5\High 5 KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\High 5\AM2 High 5 KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\PhD Nutrition\PHD KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\PhD Nutrition\AM PHD KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Meastsnacks Group\Meatsnacks KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\USN\USN KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\General Mills UK\General Mills KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Bon Bon Buddies\Bon Bon Buddies KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Bon Bon Buddies\AM Bon Bon Buddies KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Bon Bon Buddies\CONF AM Bon Bon Buddies KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Symington's Ltd\CONF Symingtons KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Symington's Ltd\Symingtons KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Copernus\Copernus KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Dale Farm\Dale Farm KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Tayto Group Ltd\Tayto Group KW10.17.xlsx G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW10\Tayto Group Ltd\CONF Tayto Group KW10.17.xlsx '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3 '[]Sheet1'!R15C3

编辑5：

用@dee提供的代码我仍然得到相同的错误。 错误1004. Heres'我如何使用他的代码： 

 Sub SO() If Range("I8").Value = "" Then Exit Sub Else Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False '//Set your file path Dim parentFolder As String parentFolder = Range("I8").Value '// change as required, keep trailing slash If Dir(parentFolder) = "" Then parentFolder = Range("I8").Value & "\" '// change as required, keep trailing slash Else parentFolder = Range("I8").Value End If '//Fetch Results Dim results As String results = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & "*.xls*"" /S /B /A:-D").StdOut.ReadAll Dim files, i, r, path, file, arg, macroResult files = Split(Strings.Trim(results), vbCrLf) ReDim values(LBound(files) To UBound(files, 1), 0 To 1) For r = LBound(files) To UBound(files, 1) If Strings.Trim(files(r)) <> "" Then i = InStrRev(files(r), "\") file = Replace(file, "'", "''") path = Replace(path, "'", "''") arg = "'" & path & "[" & file & "]Sheet1'!R15C3" macroResult = ExecuteExcel4Macro(arg) If Not VBA.IsError(macroResult) Then values(r, 0) = macroResult values(r, 1) = file Else values(r, 0) = "No email was found" End If End If Next 'Write values to sheet fileRng.Offset(, 16).Value = values '// end email copy code errHandler: Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End If Exit Sub errHandler2: MsgBox "Could not locate folder directory." Exit Sub End Sub

错误在这一行： 

 macroResult = ExecuteExcel4Macro(arg)

正如我在我的评论中提到的那样，使用Scripting.FileSystemObject遍历文件夹和文件比分析命令行DIR命令的输出（就像您在问题中所做的那样），甚至使用VBA内置Dirfunction。

添加对Microsoft脚本运行时的引用（ 工具 – > 引用… ）。

那么你可以使用下面的代码： 

 Sub SO() Dim fso As New FileSystemObject Dim weekFolder As Folder 'replace 1 with either the name or the index of the worksheet which holds the week folder path 'replace B4 with the address of the cell which holds the week folder path Set weekFolder = fso.GetFolder(Worksheets(1).Range("B4").Value) Dim supplierFolder As Folder, fle As file For Each supplierFolder In weekFolder.SubFolders For Each fle In supplierFolder.files 'test whether this is an Excel file If fle.Type Like "*Excel*" Then 'process the file here End If Next Next End Sub

一旦你有文件path，你可以做一些类似于你已经做的事情：用一个不同的（隐藏的）Excel实例打开文件，并阅读C15的内容。 我会远离ExecuteExcel4Macro （这实际上是为了运行Excel V4macros ），而是直接读取内容。

但是，程序中似乎存在逻辑错误。 如果各个子文件夹中的Excel文件多于或less于当前文件列表，会发生什么情况？ 为了处理这种可能性，我不会以现有的列表作为文件读取的基础（就像你正在做的那样 – files = fileRng.Value2 ）。

相反，我会清除每次运行之间的列表。 然后，我将遍历每个文件夹，然后遍历每个子文件夹，然后遍历子文件夹中的每个文件，并testing每个文件是否为Excel文件。 如果是，则将文件中的path和电子邮件添加到Scripting.Dictionary ，该Scripting.Dictionary包含（唯一）键和（非唯一值）对。 在search结束时，path和电子邮件可以很容易地粘贴到工作表中。

（注意：使用字典还有一个额外的好处，因为你不必担心resize。） 

 Sub SO() 'clear the existing list here -- not implemented '... Dim pathsEmails As New Dictionary Dim app As New Excel.Application Dim fso As New FileSystemObject Dim weekFolder As Folder 'replace 1 with either the name or the index of the worksheet which holds the week folder path 'replace B4 with the address of the cell which holds the week folder path Set weekFolder = fso.GetFolder(Worksheets(1).Range("B4").Value) Dim supplierFolder As Folder, fle As file For Each supplierFolder In weekFolder.SubFolders For Each fle In supplierFolder.files 'test whether this is an Excel file If fle.Type Like "*Excel*" Then 'open the workbook, read and save the email, and close the workbook Dim book As Workbook Set book = app.Workbooks.Open(fle.path, , True) pathsEmails(fle.path) = book.Worksheets("Sheet1").Range("C15").Value book.Close False End If Next Next app.Quit 'copy the paths and emails to the worksheet '(as above) replace 1 with either the name or the index of the worksheet which holds the week folder path 'paths are pasted in starting at cell B6, downwards 'emails are pasted in starting at cell C6, downwards Worksheets(1).Range("B6").Resize(UBound(pathsEmails.Keys) + 1, 1).Value = WorksheetFunction.Transpose(pathsEmails.Keys) Worksheets(1).Range("C6").Resize(UBound(pathsEmails.Items) + 1, 1).Value = WorksheetFunction.Transpose(pathsEmails.Items) End Sub

参考文献：

VBA语言

  • Option Explicit语句
  • Like运营商
  • Instrfunction
  • InstrRevfunction

FileSystemObject的

  • FileSystemObject对象
  • 文件夹对象
  • 子 文件夹属性和文件夹集合
  • 文件对象

字典

  • MSDN
  • 键方法
  • 项目方法

Excel对象

  • 应用程序对象， 工作簿属性
  • Workbooks集合， Open方法， Workbook对象
  • 工作表属性， 工作表集合， 工作表对象， 范围属性
  • closures方法
  • Range对象， Resize属性， Value属性
  • 移调方法，对应于Excel TRANSPOSE工作表函数

在将file和pathvariables发送到ExecuteExcel4Macro之前，也就是在编写arg参数之前，可以“撇开” file和pathvariables中的撇号。 

 file = Replace(file, "'", "''") path = Replace(path, "'", "''") arg = "'" & path & "[" & file & "]Sheet1'!R15C3" values(r, 1) = ExecuteExcel4Macro(arg)

无论原始名称是否包含'否”，这都将起作用（在后一种情况下，将不会进行任何修改）。

与几乎所有的string解释器一样， ExecuteExcel4Macro方法在命令string中观察偶数个撇号时，会将它们分为两部分，并将它们作为正楷字符（即不会解释它们）。 这被称为转义 。

编辑

要明确描述不工作的公式，可以编写它来检测并打印它们： 

 On Error Resume Next values(r, 1) = ExecuteExcel4Macro(arg) If Err.Number <> 0 Or IsError(values(r, 1)) Or IsEmpty(values(r, 1)) Then Debug.Print arg On Error Goto 0

得到一个错误的公式列表将有助于解决这个问题。

在你的代码中，你有一些逻辑错误导致argvariables包含无效path。 这是简单的例子，它可以如何工作。 将results作为数组使用，而不写入表单。 最后检查ExecuteExcel4Macro错误值，因为当目标单元格不包含数据时，这将返回错误。 否则，你的代码工作。 HTH 

 Dim results As String results = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & "*.xls*"" /S /B /A:-D").StdOut.ReadAll Dim files, i, r, path, file, arg, macroResult files = Split(Strings.Trim(results), vbCrLf) ReDim values(LBound(files) To UBound(files, 1), 0 To 1) For r = LBound(files) To UBound(files, 1) If Strings.Trim(files(r)) <> "" Then i = InStrRev(files(r), "\") path = Left(files(r), i) file = Right(files(r), Len(files(r)) - i) arg = "'" & path & "[" & file & "]Sheet1'!R15C3" macroResult = ExecuteExcel4Macro(arg) If Not VBA.IsError(macroResult) Then values(r, 0) = macroResult values(r, 1) = file Else values(r, 0) = "No email was found" End If End If Next

注意：正确的arg值如下所示：

G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW1\[AM Arla Foods UK KW1.17.xlsx]Sheet1'!R15C3 G:\BUYING\Food Specials\2. Planning\3. Confirmation and Delivery\Announcements\2017\KW1\[AM Arla Foods UK KW1.17.xlsx]Sheet1'!R15C3 。

在这里输入图像说明

当arg看上去像这样的'[]Sheet1'!R15C3那么下面的错误发生了，它表示你的代码中仍然有错误，并且argvariables有无效的数据。

在这里输入图像说明

我想你想列出所有文件夹和所有子文件夹中的所有文件。 看看这个链接。

http://www.learnexcelmacro.com/wp/2011/11/how-to-get-list-of-all-files-in-a-folder-and-sub-folders/

下载文件; 这是要走的路。 如果你想看VBA，基本上就是这样。 。 。 

 view plaincopy to clipboardprint? Sub GetFilesInFolder(SourceFolderName As String) '--- For Example:Folder Name= "D:\Folder Name\" Dim FSO As Scripting.FileSystemObject Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder Dim FileItem As Scripting.File Set FSO = New Scripting.FileSystemObject Set SourceFolder = FSO.GetFolder(SourceFolderName) '--- This is for displaying, whereever you want can be configured r = 14 For Each FileItem In SourceFolder.Files Cells(r, 2).Formula = r - 13 Cells(r, 3).Formula = FileItem.Name Cells(r, 4).Formula = FileItem.Path Cells(r, 5).Formula = FileItem.Size Cells(r, 6).Formula = FileItem.Type Cells(r, 7).Formula = FileItem.DateLastModified Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)" r = r + 1 ' next row number Next FileItem Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub view plaincopy to clipboardprint? Sub GetFilesInFolder(SourceFolderName As String, Subfolders As Boolean) '--- For Example:Folder Name= "D:\Folder Name\" and Flag as Yes or No Dim FSO As Scripting.FileSystemObject Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder Dim FileItem As Scripting.File 'Dim r As Long Set FSO = New Scripting.FileSystemObject Set SourceFolder = FSO.GetFolder(SourceFolderName) '--- This is for displaying, whereever you want can be configured r = 14 For Each FileItem In SourceFolder.Files Cells(r, 2).Formula = r - 13 Cells(r, 3).Formula = FileItem.Name Cells(r, 4).Formula = FileItem.Path Cells(r, 5).Formula = FileItem.Size Cells(r, 6).Formula = FileItem.Type Cells(r, 7).Formula = FileItem.DateLastModified Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)" r = r + 1 ' next row number Next FileItem '--- This is the Function to go each and Every Folder and get the Files. This is a Nested-Function Calling. If Subfolders = True Then For Each SubFolder In SourceFolder.Subfolders ListFilesInFolder SubFolder.Path, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
Interesting Posts

Excel中的每个条目如何将“matrix” – 表格转换为一行

Sumif不返回值

使用macros水平移调单个多行单元

使用VBA将Excel数据导入现有的Word文档

Excel VBA-尝试基于值将值复制到汇总表

在服务器上运行Excel – C＃Interop Excel

时间比较没有捕捉

login到网站

VBAselect性地将双字节转换为单字节字符

存储到函数VBA的variables结果中