Vba循环在一张Excel工作表上的一个文件夹中打开多个文本文件

Question

我在使用 vba 循环将 21 个文本文件导入到一张 Excel 表格时遇到问题。 我在这里找到了这个，但一直收到错误代码。我希望 vba 循环遍历一个文件夹，复制并粘贴到主文件，与数据集上方的文件相隔一列。

Sub combine()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Dim ExcelApp As Object
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = False
    ExcelApp.ScreenUpdating = False
    ExcelApp.DisplayAlerts = False
    ExcelApp.EnableEvents = False

    '**VARIABLES**
    Dim folderPath As String
    folderPath = "Y:\plan_graphs\final\mich_alco_test\files\"

    'COUNT THE FILES
    Dim totalFiles As Long
    totalFiles = 0
    Dim fileTitle As String
    fileTitle = Dir(folderPath & "*.xl??")
    Do While fileTitle <> ""
    totalFiles = totalFiles + 1
    fileTitle = Dir()
    Loop

    'OPENING FILES
    Dim resultWorkbook As Workbook
    Dim dataWorkbook As Workbook
    Set resultWorkbook = ExcelApp.Application.Workbooks.Open("Y:\plan_graphs\final\mich_alco_test\result.xlsx")


    fileTitle = Dir(folderPath & "*.xl??")

    'FOR EACH FILE
    Do While fileTitle <> ""
        Set dataWorkbook = ExcelApp.Application.Workbooks.Open(folderPath & fileTitle)
        dataWorkbook.Worksheets("List1").Range("A1").Select
        dataWorkbook.Worksheets("List1").Selection.CurrentRegion.Select


         `resultWorkbook.Range
         fileTitle = Dir()
     Loop

    ExcelApp.Quit
    Set ExcelApp = Nothing
End Sub

谢谢。

Answer 1

未经测试：

Sub combine()

    Const FOLDER_PATH As String = "Y:\plan_graphs\final\mich_alco_test\"

    Dim resultWorkbook As Workbook, fileTitle, i as long
    Dim dataWorkbook As Workbook
    Set resultWorkbook = Workbooks.Open(FOLDER_PATH & "result.xlsx")

    i = 0 
    fileTitle = Dir(FOLDER_PATH & "files\*.xl??")

    Do While fileTitle <> ""
        i = i + 1 
        With Workbooks.Open(folderPath & "files\" & fileTitle)
            .Worksheets("List1").Range("A1").CurrentRegion.Copy _
               resultWorkbook.Sheets("data").Cells(2,i)
            .Close False 'don't save
        End With
        resultWorkbook.Sheets("data").Cells(1, i).Value = fileTitle 
        fileTitle = Dir()
    Loop

End Sub

如果您已经在 Excel 中，则无需创建新实例来执行此操作。