循环浏览指定文件夹中的文件并将其导入 Excel

Question

我正在尝试找到一种方法让 Excel 循环遍历各种 HTML 文件并一次导入一个，在移动到下一个文件之前以指定的方式格式化每个文件。这些文件都在 FOLDER2 中。我如何修改它以不仅考虑 FILE 还考虑 FILE 1....n？我遇到的一个直接问题是我收到“运行时错误'1004'：Microsoft Excel 无法打开或读取此查询文件。”我怀疑这是因为它是 HTML 而不是 XML。当我手动告诉 Excel 选择所有文件时没有问题，但也许宏没有这样做？

With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;file:///C:/Users/FOLDER1/FOLDER2/FILE", Destination:= _
        Range("$A$1"))
        .CommandType = 0
        .Name = "FILE"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

更新：

我正在尝试修改以下代码，以便我可以简单地选择文件夹并让它通过这种方式运行。这是一个合理的方法吗？

Sub ImportXMLData()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim xlWkBk As Workbook, xmlFile As Workbook, LastRow As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.html", vbNormal)
Set xlWkBk = ThisWorkbook
While strFile <> ""
  LastRow = xlWkBk.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row + 1
  Set xmlFile = Workbooks.OpenXML(Filename:=strFolder & "\" & strFile)
  xmlFile.Sheets(1).UsedRange.Copy
  xlWkBk.Sheets(1).Cells(LastRow, 1).Paste
  xmlFile.Close SaveChanges:=False
  strFile = Dir()
Wend
Set xmlFile = Nothing: Set xlWkBk = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Answer 1

您可以使用FileSystemObject（需要添加对 Microsoft Scripting Runtime 的引用）来循环浏览文件夹的内容：

sub loopThroughFolder(folderPath as string)

dim fso as new FileSystemObject
dim fileObj as file

for each fileObj in fso.GetFolder(folderPath).Files
 if filenameFitsCriteria(fileObj.name) then
  importFile(fileObj.Path)
next

end sub

对于选择文件夹的界面，可以查看：

Application.FileDialog(msoFileDialogFolderPicker)