Run-time error for Macro

MsTwiitch

New Member
Joined
Nov 19, 2021
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hey all!
I'm trying to rework an excel file/"tool" that hasn't been updated in ~5 years or so. It's to track missing timecard punches for our co-workers. We use KRONOS as our timekeeping platform. We export a "Punch Origin" report that is then pulled into this tool via a macro button. I had a lot of issues getting that file to export and save correctly, but I finally got that bit worked out.

Now, when I click the macro button to import this file, I get a "Run-time error '52': Bad file name or number" error.

When I click "debug," it opens the VBA code and this is what it looks like:

1665175319825.png


I know next to nothing about VBA and macros. I checked the file location, it's in the same folder as the workbook I'm working in and named correctly (I changed the exported name of "Punch Origin" to "OpenReport").

Any ideas on what, if anything, I can do to get this to work?
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Better if you copied the code from that procedure and pasted it in a post - please use code tags to maintain readability (vba button on posting toolbar). It might then become obvious or at least people will be able to ask questions. The error message is fairly straight forward though.
Or, when it stops there, type in the immediate window at the bottom:
?Len(ThisWorkbook.Path & "\OpenReport.xml" hit enter and see if it looks properly formatted and matches your file path. In fact, copy the resulting output into Windows File Explorer and see if it takes you there.
 
Upvote 0
Better if you copied the code from that procedure and pasted it in a post - please use code tags to maintain readability (vba button on posting toolbar). It might then become obvious or at least people will be able to ask questions. The error message is fairly straight forward though.
Or, when it stops there, type in the immediate window at the bottom:
?Len(ThisWorkbook.Path & "\OpenReport.xml" hit enter and see if it looks properly formatted and matches your file path. In fact, copy the resulting output into Windows File Explorer and see if it takes you there.
Hey Micron! Thanks for the reply!

Is this better? The error is in the second line of the code.

VBA Code:
Application.StatusBar = "Formatting the Report"
    If Len(Dir(ThisWorkbook.Path & "\OpenReport.xml")) = 0 Then
        MsgBox (ThisWorkbook.Path & "\OpenReport.xml" & " does not exist.  Please check the file location and try again")
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        Application.StatusBar = ""
        Exit Sub
    End If
    Set Wkbook = Workbooks.Open(ThisWorkbook.Path & "/OpenReport.xml")

My apologies, I don't understand what you mean about typing in the immediate window at the bottom. Is this supposed to be the bottom of the debug window?
 
Upvote 0
That only shows anyone the same code you posted. I was looking for the whole procedure but nice use of the code tags.
Re immediate window - it's labeled as such:

1665177696915.png


then there is Google when you don't understand a term. Good practice to do that (I think) as you'll always learn more than the response you get.
 
Upvote 0
Also, have you declared the Path as string
AND
Have you created a variable for Path, eg
VBA Code:
Path= C:\Users\...
 
Upvote 0
That only shows anyone the same code you posted. I was looking for the whole procedure but nice use of the code tags.
Re immediate window - it's labeled as such:

View attachment 75739

then there is Google when you don't understand a term. Good practice to do that (I think) as you'll always learn more than the response you get.
Ah, yes, that makes sense. Let me try this again.

VBA Code:
Sub FilterMP()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Dim Wkbook As Workbook
    Dim ColumnTest As String
    ThisWorkbook.Sheets("DATA ENTRY").Range("A1").Value = "."
    Call SortData
    Application.ScreenUpdating = False
    Z = MsgBox("Are you ready to import " & ThisWorkbook.Path & "\OpenReport.xml?" & vbNewLine & _
               "This is the Punch Origin report from KRONOS that should be converted to .XML" & vbNewLine & _
               vbNewLine & _
               "This should only be done after the Pay Period has been closed.", vbYesNo)
    
    If Z = vbNo Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        Application.StatusBar = ""
        Exit Sub
    End If
    Application.StatusBar = "Formatting the Report"
    If Len(Dir(ThisWorkbook.Path & "\OpenReport.xml")) = 0 Then
        MsgBox (ThisWorkbook.Path & "\OpenReport.xml" & " does not exist.  Please check the file location and try again")
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        Application.StatusBar = ""
        Exit Sub
    End If
    Set Wkbook = Workbooks.Open(ThisWorkbook.Path & "/OpenReport.xml")
    
    ActiveSheet.Cells.UnMerge
    Application.ScreenUpdating = False
    
    If ActiveSheet.Range("A1").Value = "Punch Date/time" Then
        ActiveSheet.Range("F2").Activate
    Else
        ActiveSheet.Range("F1").Activate
    End If
    
    For x = 1 To 5
    If ActiveCell.Value = "ID:" Then
        Columns(ActiveCell.Column).Delete
        x = 5
    Else
        ActiveCell.Offset(0, 1).Activate
    End If
    Next x
    
    Application.StatusBar = "Formating the Report"
    'Application.ScreenUpdating = True
    For x = 1 To ActiveSheet.Range("A65536").End(xlUp).Row
        
        ActiveSheet.Range("B" & x & ":E" & x).Merge
        ActiveSheet.Range("G" & x & ":H" & x).Merge
        If Len(Application.StatusBar) > 26 Then
        Application.StatusBar = "Formating the Report"
    Else
        If x Mod 100 = 0 Then
            Application.StatusBar = Application.StatusBar & "."
        End If
    End If
    Next x
    ActiveSheet.Range("C:C").ColumnWidth = 25
    
    ActiveSheet.Range("B2").Activate
    
    Application.StatusBar = "Purging SuperUsers"
    For x = 1 To ActiveSheet.Range("A65536").End(xlUp).Row
        Do While ActiveCell.Column <= 1
            ActiveCell.Offset(0, 1).Activate
        Loop
        Do While ActiveCell.Column > 4
            ActiveCell.Offset(0, -1).Activate
        Loop
        If ActiveSheet.Cells(ActiveCell.Row, 1).Value Like "*Punch*" Then
            Rows(ActiveCell.Row).EntireRow.Delete
        Else
            If ActiveCell.Value = "SuperUser" Or ActiveCell.Value = "JMULLIGAN" Or ActiveCell.Value Like "*Punch*" Then
                 Rows(ActiveCell.Row).EntireRow.Delete
            Else
                ActiveCell.Offset(1, 0).Activate
            End If
        End If
    If Len(Application.StatusBar) > 22 Then
        Application.StatusBar = "Purging SuperUsers"
    Else
        If x Mod 100 = 0 Then
            Application.StatusBar = Application.StatusBar & "."
        End If
    End If
    Next x
    Dim FileCheck As String
        Wkbook.Close True
        Application.StatusBar = ""
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        Application.StatusBar = ""
        Call ImportMP
        On Error Resume Next
            Kill (ThisWorkbook.Path & "/OpenReport.xml")
            Kill (ThisWorkbook.Path & "/OpenReport.pdf")
        Call Purge1Year
        MsgBox ("Import Complete")
End Sub


Sub ImportMP()

Application.StatusBar = "Working on it."

Dim CoworkerNumber, Mgr, MPDate As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.StatusBar = "Sending MP to Tracker"
Application.Calculation = xlCalculationManual
Dim Wkbook, MPwkBook As Workbook
    
Set MPwkBook = ThisWorkbook
    
Set Wkbook = Workbooks.Open(ThisWorkbook.Path & "/OpenReport.xml")



Do While ActiveSheet.Range("E2") = ""
    ActiveSheet.Range("B2").Activate
    If ActiveSheet.Range("E2").Value = "" Then
        Range("E:E").EntireColumn.Delete
    End If
Loop
    For x = 1 To ActiveSheet.Range("A65536").End(xlUp).Row
        
        
        Do While ActiveCell.Column <= 1
            ActiveCell.Offset(0, 1).Activate
        Loop
        
        Do While ActiveCell.Column > 4
            ActiveCell.Offset(0, -1).Activate
        Loop
    If ActiveCell.Value = "ID:" Then
        ActiveCell.Value = ""
    End If
    If ActiveCell.Value = "" And ActiveCell.Offset(0, 1).Value <> "" Then ' COWORKER CHECK
        CoworkerNumber = ActiveCell.Offset(0, 1).Value
        Mgr = ""
        MPDate = ""
        
    End If
    If ActiveCell.Value <> "" Then ' MP CHECK
        Mgr = ActiveCell.Value
        If ActiveCell.Column = 1 Then
            MPDate = ActiveCell.Offset(0, -ActiveCell.Column).Value
            MPDate = Format(MPDate, "short date")
        Else
            MPDate = ActiveCell.Offset(0, -ActiveCell.Column + 1).Value
            MPDate = Left(MPDate, 10)
            MPDate = Left(MPDate, InStrRev(MPDate, "/") + 4)
            
        End If
        If MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Value <> CoworkerNumber And Format(MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Value, "mm/dd/yyyy") <> Format(MPDate, "mm/dd/yyyy") Or MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Value <> CoworkerNumber And Format(MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Value, "mm/dd/yyyy") = Format(MPDate, "mm/dd/yyyy") Or MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Value = CoworkerNumber And Format(MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Value, "mm/dd/yyyy") <> Format(MPDate, "mm/dd/yyyy") Then
            If CoworkerNumber = "" Then
                MsgBox ("error")
            Else
                MPwkBook.Sheets("Data Entry").Range("A65536").End(xlUp).Offset(1, 0).Value = CoworkerNumber
                MPwkBook.Sheets("Data Entry").Range("B65536").End(xlUp).Offset(1, 0).Value = MPDate
                MPwkBook.Sheets("Data Entry").Range("C65536").End(xlUp).Offset(1, 0).Value = Mgr
            End If
        End If
        
    End If
    If Len(Application.StatusBar) > 40 Then
        Application.StatusBar = "Sending MP to Tracker"
    Else
        If x Mod 50 = 0 Then
            Application.StatusBar = Application.StatusBar & "."
        End If
        
    End If
    
    ActiveCell.Offset(1, 0).Activate

Next x
'MPwkBook.Save

Wkbook.Close False
Set Wkbook = Nothing
Application.StatusBar = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = ""
Call SortData2

MsgBox ("All Done!")

End Sub



Sub SortData()

Application.StatusBar = "Restoring Data"
Application.ScreenUpdating = False

If ThisWorkbook.Sheets("DATA ENTRY").FilterMode Then ThisWorkbook.Sheets("DATA ENTRY").ShowAllData

ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Clear
    ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A3:A5613"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
        Range("B3:B5613"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Application.ScreenUpdating = True
Application.StatusBar = ""

End Sub

Sub SortData2()

ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Clear
    ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
        Range("E3:E" & ThisWorkbook.Sheets("DATA ENTRY").Range("A65500").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
        Range("I3:I" & ThisWorkbook.Sheets("DATA ENTRY").Range("A65500").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort.SortFields.Add Key:= _
        Range("B" & ThisWorkbook.Sheets("DATA ENTRY").Range("A65500").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ThisWorkbook.Worksheets("DATA ENTRY").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

Sub ShowLegend()
    Legend.Show
End Sub

Sub Purge1Year()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Purging Data"
    Call SortData

    For x = 3 To ThisWorkbook.Sheets("DATA ENTRY").Range("A3").End(xlDown).Row
        If ThisWorkbook.Sheets("DATA ENTRY").Range("B" & x).Value <= Date - 365 Then
            ThisWorkbook.Sheets("DATA ENTRY").Range("A" & x & ":D" & x).Value = ""
        ElseIf ThisWorkbook.Sheets("DATA ENTRY").Range("B" & x).Value <= Date - 90 And IsError(ThisWorkbook.Sheets("DATA ENTRY").Range("I" & x).Value) Then
            ThisWorkbook.Sheets("DATA ENTRY").Range("A" & x & ":D" & x).Value = ""
        End If
        Application.StatusBar = "Purging Data " & x - 2 & " out of " & ThisWorkbook.Sheets("DATA ENTRY").Range("A65000").End(xlUp).Row - 2
    Next x
    Call SortData
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Application.StatusBar = "Purge Complete"
    'MsgBox ("Purge Complete")
    Application.StatusBar = ""
End Sub

Sub PurgeData()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Purging Data"
    Dim PurgeNumber As Integer
    Call SortData
    PurgeNumber = InputBox("How many days back to you want to purge?")
    If IsNumeric(PurgeNumber) = False Then
    Do While IsNumeric(PurgeNumber)
        PurgeNumber = InputBox("How many days back to you want to purge?")
    Loop
    End If
    For x = 3 To ThisWorkbook.Sheets("DATA ENTRY").Range("A3").End(xlDown).Row
        If ThisWorkbook.Sheets("DATA ENTRY").Range("B" & x).Value <= Date - PurgeNumber Then
            ThisWorkbook.Sheets("DATA ENTRY").Range("A" & x & ":D" & x).Value = ""
        End If
        Application.StatusBar = "Purging Data " & x - 2 & " out of " & ThisWorkbook.Sheets("DATA ENTRY").Range("A65000").End(xlUp).Row - 2
    Next x
    Call SortData
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Application.StatusBar = "Purge Complete"
    MsgBox ("Purge Complete")
    Application.StatusBar = ""
End Sub

Sub MPnotTurnedInReport()
    ThisWorkbook.Sheets("MP NOT TURNED IN").Visible = True
    ThisWorkbook.Sheets("MP NOT TURNED IN").Activate
End Sub

Sub MPIssuesReport()
    ThisWorkbook.Sheets("MP Issues by Cost Center").Visible = True
    ThisWorkbook.Sheets("MP Issues by Cost Center").Activate
End Sub

Sub MPMgrReport()
    ThisWorkbook.Sheets("MP Issues by MGR").Visible = True
    ThisWorkbook.Sheets("MP Issues by MGR").Activate
End Sub

Sub GoToReport()
    Test = ActiveSheet.Name
    ThisWorkbook.Sheets("REPORT").Activate
    ThisWorkbook.Sheets(Test).Visible = False
End Sub


Sub BackToDataEntry()
    Test = ActiveSheet.Name
    ThisWorkbook.Sheets("DATA ENTRY").Activate
    ThisWorkbook.Sheets(Test).Visible = False
End Sub
 
Upvote 0
Still waiting for results of post 2 and 4
when it stops there, type in the immediate window at the bottom:
?Len(ThisWorkbook.Path & "\OpenReport.xml" hit enter and see if it looks properly formatted and matches your file path. In fact, copy the resulting output into Windows File Explorer and see if it takes you there
 
Upvote 0

Forum statistics

Threads
1,224,926
Messages
6,181,794
Members
453,067
Latest member
cernytomas

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top