Runtime error '5': Invalid procedure call or argument-CodePudding

I have used the following code before and worked as expected for a handful times. 4 hours later it did not work. I added the MsgBox "File: " and confirm the filename path is error free.

Option Explicit

Sub ExportAsPDF()

Dim Folder_Path As String

Dim NameOfWorkbook

NameOfWorkbook = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder path"
    
    If .Show = -1 Then Folder_Path = .SelectedItems(1)

End With

If Folder_Path = "" Then Exit Sub

Dim sh As Worksheet
Dim fn As String

For Each sh In ActiveWorkbook.Worksheets
    fn = Folder_Path & Application.PathSeparator & NameOfWorkbook & "_" & sh.Name & ".pdf"
    MsgBox "File: " & fn
    sh.PageSetup.PaperSize = xlPaperA4
    sh.PageSetup.LeftMargin = Application.InchesToPoints(0.5)
    sh.PageSetup.RightMargin = Application.InchesToPoints(0.5)
    sh.PageSetup.TopMargin = Application.InchesToPoints(0.5)
    sh.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
    sh.PageSetup.HeaderMargin = Application.InchesToPoints(0.5)
    sh.PageSetup.FooterMargin = Application.InchesToPoints(0.5)
    sh.PageSetup.Orientation = xlPortrait
    sh.PageSetup.CenterHorizontally = True
    sh.PageSetup.CenterVertically = False
    sh.PageSetup.FitToPagesTall = 1
    sh.PageSetup.FitToPagesWide = 1
    sh.PageSetup.Zoom = False
    sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fn, Quality:=xlQualityStandard, OpenAfterPublish:=True

Next

MsgBox "Done"

End Sub

Is there anything I missed?

Microsoft® Excel® for Microsoft 365 MSO (Version 2211 Build 16.0.15831.20220) 64-bit

CodePudding user response：

If the ActiveWorkbook is new and was never stored, the workbook name is a generic name without any extension, eg Book1. In that case, InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) will return 0. Because you are nesting two commands, this 0 will be passed as parameter to the Left function, and Left(Name, 0) throws that runtime error 5.

Workaround: Write the result of InstrRev into an intermediate variable and check it. My advice is to avoid nested commands because it is much harder to check what exactly fails if there is an error because 0 is an invalid parameter.

Dim p As Long
p = InStrRev(ActiveWorkbook.Name, ".")
If p = 0 Then
    NameOfWorkbook = ActiveWorkbook.Name
Else
    NameOfWorkbook = Left(ActiveWorkbook.Name, p - 1)
End If

An alternative way to get the filename without extension is to use the FileSystemObject-method GetBaseName (will not work on a Mac)

nameOfWorkbook = CreateObject("Scripting.fileSystemObject").GetBasename(ActiveWorkbook.FullName)

CodePudding user response：

Export Worksheets to Single PDFs

I could produce the error only when a worksheet was not visible (hidden or very hidden). The following deals with that and a few more issues.

Sub ExportAsPDF()
    
    Const PROC_TITLE As String = "Export As PDF"
    Const EXPORT_ONLY_VISIBLE_WORKSHEETS As Boolean = False
    
    If ActiveWorkbook Is Nothing Then
        MsgBox "No visible workbooks open.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    Dim swb As Workbook: Set swb = ActiveWorkbook
    If Len(swb.Path) = 0 Then
        MsgBox "The workbook was not saved yet." & vbLf & vbLf _
            & "Save it and try again.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    Dim dFolderPath As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder path"
        If .Show Then dFolderPath = .SelectedItems(1)
    End With
    
    If Len(dFolderPath) = 0 Then
        MsgBox "No folder selected.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    Dim swbBaseName As String: swbBaseName = swb.Name
    swbBaseName = Left(swbBaseName, InStrRev(swbBaseName, ".") - 1)

    Dim dFilePathLeft As String
    dFilePathLeft = dFolderPath & Application.PathSeparator & swbBaseName & "_"
    
    Dim sVisibility As XlSheetVisibility: sVisibility = xlSheetVisible
    
    Dim sws As Worksheet
    Dim dCount As Long
    Dim dFilePath As String
    Dim DoExport As Boolean

    For Each sws In swb.Worksheets
        
        With sws
            
            If EXPORT_ONLY_VISIBLE_WORKSHEETS Then ' only visible
                If .Visible = xlSheetVisible Then DoExport = True
            Else ' all
                If Not .Visible = xlSheetVisible Then
                    sVisibility = .Visible ' store
                    .Visible = xlSheetVisible ' make visible
                End If
                DoExport = True
            End If
            
            If DoExport Then
                With .PageSetup
                    .PaperSize = xlPaperA4
                    .LeftMargin = Application.InchesToPoints(0.5)
                    .RightMargin = Application.InchesToPoints(0.5)
                    .TopMargin = Application.InchesToPoints(0.5)
                    .BottomMargin = Application.InchesToPoints(0.5)
                    .HeaderMargin = Application.InchesToPoints(0.5)
                    .FooterMargin = Application.InchesToPoints(0.5)
                    .Orientation = xlPortrait
                    .CenterHorizontally = True
                    .CenterVertically = False
                    .FitToPagesTall = 1
                    .FitToPagesWide = 1
                    .Zoom = False
                End With
                dFilePath = dFilePathLeft & .Name & ".pdf"
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:=dFilePath, _
                    Quality:=xlQualityStandard, OpenAfterPublish:=True
                dCount = dCount   1
                DoExport = False ' reset for the next iteration
            End If
            
            If Not EXPORT_ONLY_VISIBLE_WORKSHEETS Then ' all
                If Not sVisibility = xlSheetVisible Then
                    .Visible = sVisibility ' revert
                    sVisibility = xlSheetVisible ' reset
                End If
            End If
            
        End With
    
    Next sws

    MsgBox dCount & " worksheet" & IIf(dCount = 1, "", "s") & " exported.", _
        vbInformation, PROC_TITLE

End Sub