从不同的子文件夹访问VBA导入特定的Excel文件

Question

我有一个问题，我找不到合适的代码来做到这一点。

因此，我有一个主文件夹（C：\\ Products），其中包含多个子文件夹，这些子文件夹分别对应于不同的产品（C：\\ Products \\ Chocolates，C：\\ Products \\ Milk等）。 每个子文件夹都有许多excel文件，但我只想导入一个名为sells.xlxs的文件。 每个子文件夹都有一个sells.xlxs，我想将所有sells.xlxs导入到访问数据库。

编辑：对不起，我没有上传我正在使用的代码：

Sub Insert2()
  Const cstrSheetName As String = "Weekly"
  Dim strDir As String
  Dim strFile As String
  Dim strTableName As String
  Dim MyPath As String
  Dim i As Long

  i = 0
   MyPath = "C:\Products"
   strTableName = "Sells"
  If Left(MyPath, 1) <> "\" Then
   strDir = MyPath & "\"
  Else
   strDir = MyPath
 End If
   strFile = Dir(MyPath & "\Sells.XLSX")
While strFile <> ""
 i = i + 1
 strFile = strDir & strFile
 Debug.Print "importing " & strFile

     DoCmd.TransferSpreadsheet _
    TransferType:=acImport, _
    SpreadsheetType:=acSpreadsheetTypeExcel9, _
     TableName:=strTableName, _
    FileName:=strFile, _
    HasFieldNames:=True, _
    Range:=cstrSheetName & "$"

  strFile = Dir()

 Wend
  End Sub

您认为可以帮我吗？

非常感谢

Answer 1

Dim FileSystem As Object
Dim HostFolder As String

HostFolder = MyPath

Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)

Sub DoFolder(Folder)
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        Dim File
        For Each File In Folder.Files
            ' Operate on each file
        Next
    Next

End Sub

代码归功于经过重新排列的Rich代码，因此它不会递归地迭代所有子文件夹，而仅是MyPath的子文件夹