获取下一个文件时 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 调用。这里我就postSplitDataMACRO，有空的朋友帮我看看这个。 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. 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() 循环会中断代码流。我知道问题出在哪里，如果解决了我的错误，会 post 解决方案吗？

更新

这是解决方案。我参考了答案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

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

Invalid procedure call or argument in excel VBA while getting the next file

excel

vba

data-processing