從不同的子文件夾訪問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的子文件夾