Question

我正在创建一个VBA代码，它循环遍历相同文件的文件夹（差异数据）并将它们编译成一个Excel工作表。但是，有一个错误：

“运行时错误1004：我们找不到[文件]”

    Sub LoopThroughFolderAllData()

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
     Dim Rws As Long, Rng As Range
   Dim myPath As String
   Dim FldrPicker As FileDialog


Set Wb = ThisWorkbook

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
  .Title = "Select Folder with IQC Data"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
 NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings



 'Target Path with Ending Extention
 MyFile = Dir(myPath & "*.xls*")


Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Set Wb = Workbooks.Open(Filename:=myPath & MyFile)
    Workbooks.Open (MyFile)
    With Worksheets("All Data")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(2, 1), .Cells(Rws, 70))
        Rng.Copy Wb.Worksheets("All Data").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()
Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
 'Reset Macro Optimization Settings
   Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True

 End Sub

错误发生在行：

Workbooks.Open (MyFile)

感谢任何帮助！

Answer 1

修改Do While代码如下：

Do While MyFile <> ""
    Set Wb = Workbooks.Open(Filename:=myPath & MyFile)
    With Worksheets("All Data")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(2, 1), .Cells(Rws, 70))
        Rng.Copy Wb.Worksheets("All Data").Cells(Rows.Count, 
        "A").End(xlUp).Offset(1, 0)
        wb.Close True
    End With
    MyFile = Dir()
Loop

我认为你不需要这一行

    myPath = myPath

VBA运行时错误1004“抱歉，我们可以找到文件..”。 VBA循环通过一个文件夹将所有数据编译成一个Excel工作表

1 个答案: