获取下一个文件时，excel VBA中的过程调用或参数无效[重复]

Question

我有一个宏，可以打开文件夹中的每个 excel，做一些数据处理。现在我在xFile=Dir 周围有一个错误Invalid procedure call or argument。而且我注意到它第二次打开同一个第一个文件时，就抛出了这个错误。

Dim xStrPath As String
Dim xFile As String
Dim xExtension As String
Dim wb As Workbook

xStrPath = "D:\OneDrive\Projects\TEST\"
' xExtension = "\*.xls"
xFile = Dir(xStrPath & "\*.xls")



 Do While Len(xFile) > 0
    Set wb = Workbooks.Open(Filename:=xStrPath & "\" & xFile) 'open file
    Call SplitData
    wb.Close SaveChanges:=False 'close the file

    xFile = Dir 'Get next file name
Loop

---

更新

感谢大家的帮助。现在我知道错误是因为SplitData 调用。我将在此处发布SplitData MACRO，如果有人有时间，请帮我检查一下。 SplitData 本身工作正常，不知道为什么会导致这个错误。谢谢！

基本上SplitData用于根据一列值将一个工作表拆分为不同的工作表，然后将此导出的工作表保存为新工作簿。如果工作簿存在，则在现有工作簿之后复制并粘贴。

Sub SplitData()
        'Error Handling will stop on any error
        On Error Goto errHandler

        If False Then
        errHandler:
           msgBox err.Description
           Exit Sub
        End If
        'End of Error Handler

        ' UN MERGE
        Dim cell As Range, joinedCells As Range

        For Each cell In Range("E4:I60")
            If cell.MergeCells Then
                Set joinedCells = cell.MergeArea
                cell.MergeCells = False
                joinedCells.Value = cell.Value
            End If
        Next


        ' Split to worksheets
        Const NameCol = "B"
        Const HeaderRow = 3
        Const FirstRow = 4
        Dim SrcSheet As Worksheet
        Dim TrgSheet As Worksheet
        Dim SrcRow As Long
        Dim LastRow As Long
        Dim TrgRow As Long
        Dim Device As String
        Application.ScreenUpdating = False
        Set SrcSheet = ActiveSheet
        LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If IsEmpty(SrcSheet.Cells(SrcRow, NameCol).Value) Then Exit For

            Device = SrcSheet.Cells(SrcRow, NameCol).Value
            Set TrgSheet = Nothing
            On Error Resume Next
            Set TrgSheet = Worksheets(Device)
            On Error GoTo 0
            If TrgSheet Is Nothing Then
                Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                TrgSheet.Name = Device
                SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
            End If
        TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
        SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
        Next SrcRow
        ' NO SAVE!
        Application.ScreenUpdating = True


        ' Export worksheet
        Dim Pointer As Long
        Dim FilePath As String
        Set MainWorkBook = ActiveWorkbook
        Range("E4").Value = MainWorkBook.Sheets.Count

        Application.ScreenUpdating = False   'enhance the performance
        For Pointer = 2 To MainWorkBook.Sheets.Count
            Set NewWorkbook = Workbooks.Add
            MainWorkBook.Sheets(Pointer).Copy After:=NewWorkbook.Sheets(1)
            Application.DisplayAlerts = False
            NewWorkbook.Sheets(1).Delete
            Application.DisplayAlerts = False
            With NewWorkbook
                Filename = "D:\LIDA7\OneDrive - Orient Overseas Container Line Ltd\Projects\9. Hardware_List\TEST\" & MainWorkBook.Sheets(Pointer).Name & ".xls"
                FilePath = Dir(Filename)

                ' if file does not exist, save as new file name
                If FilePath = "" Then
                    .SaveAs Filename
                    NewWorkbook.Close (0)
                ' if file exists, copy the new workbook content to the existing file
                Else
                    Dim newlast As String   ' new workbook last row
                    Dim originlast As String
                    Dim wb As Workbook
                    Dim rng1 As Range

                    ' select the current new workbook data
                    newlast = NewWorkbook.Sheets(1).Cells(Sheets(1).Rows.Count, "B").End(xlUp).Row
                    Set rng1 = Range("A4" & newlast)
                    rng1.Select
                    Selection.Copy

                    ' paste in existing file's last row
                    Set wb = Workbooks.Open(Filename)
                    originlast = wb.Sheets(1).Cells(Sheets(1).Rows.Count, "B").End(xlUp).Row
                    wb.Sheets(1).Range("B" & originlast).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                    Application.DisplayAlerts = False
                    wb.Close True

                End If
            End With
        Next Pointer
        Application.ScreenUpdating = True
End Sub

Answer 1

显然，如果在子程序中调用 Dir() 时使用 Dir() 循环将破坏代码流。我知道问题出在哪里，如果解决了我的错误，我会发布解决方案。

更新

这是解决方案。我提到了答案here。非常感谢。

 ' looping with dir when dir is called in sub will break the code
    ' solution: use first loop to store the filename
    Dim myArray() As String
    ReDim myArray(0)

    While (xFile <> "")
        ReDim Preserve myArray(UBound(myArray) + 1)
        myArray(UBound(myArray)) = xFile
        xFile = Dir()
    Wend

    ' second loop, used store array to call sub
    Dim n As Integer
    For n = 1 To UBound(myArray)
        Set wb = Workbooks.Open(Filename:=xStrPath & "\" & myArray(n)) 'open file
        Call SplitData
        wb.Close SaveChanges:=False
    Next