Search code examples
excelvbadata-processing

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


I have a macro that opens each excel in a folder do do some data processing. Now I have a error Invalid procedure call or argument around the line xFile=Dir. And I noticed that the second time it opened the same first file, then just throwing this error.

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

Update

Thanks everyone for your help. Now I know the error is because the SplitData Call. I will post SplitData MACRO here, if anyone has time, please help me check this. The SplitData itself works fine, Don't know why it will lead to this error. Thanks!

And basically SplitData is used to split one worksheet into different worksheets based on one column value, then save this exported worksheet as new workbook. If the workbook exists, copy and paste after the existing one.

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

Solution

  • So apparently if looping with Dir() when Dir() is called in a sub will break code flow. I know where the problem is, will post the solution if solved my bug.

    update

    Here's the solution. I referred to the answer here. Thanks a lot.

     ' 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