Visual Basic Macro in Excel has stopped working (I'm assuming because of an upgrade)

Question

I have run a Visual Basic macro in Excel for many years which splits a worksheet page into individual pdfs. It has now stopped working with run time error 1004.

I have tried adjusting the file location (previously, I couldn't get this to work on sharepoint/onedrive locations so save it locally to my PC) but nothing seems to work. I have tried running this from previous workbooks which worked correctly in the past and they no longer work as well despite the fact that nothing has changed.

Sub PoolPDF()

'

' PoolPDF Macro

'

Dim rawDate As Date: rawDate = Sheets("Input").Range("G6").Value

Dim rDate As String: rDate = Format(rawDate, "d mmmm yyyy")

Dim rYear As String: rYear = Year(rawDate)

Dim rCycle As String: rCycle = 1 + Int((rawDate - DateSerial(rYear, 1, 1)) / 28)

Dim cyclePath As String: cyclePath = "C:\Users\MyName\Documents" & rYear & "" & rCycle & " - Cycle Ending " & rDate & ""

Dim poolPath As String: poolPath = cyclePath & "Royalty Pool"

'Create individual royalty pool royalty statements

For i = 1 To 5

Dim rName As String 

If i = 1 Then rName = "Name1" 

If i = 2 Then rName = "Name2" 

If i = 3 Then rName = "Name3" 

If i = 4 Then rName = "Name4" 

If i = 5 Then rName = "Name5" 

Dim rSuffix As String: rSuffix = "" 

If i = 1 Then rSuffix = " Suffix1" 

If i = 5 Then rSuffix = " Suffix2" 

Sheets("Royalty Pool").ExportAsFixedFormat Type:=xlTypePDF, Filename:= \_ 

    poolPath & rName & " - Royalty Pool - Cycle Ending " & rDate & rSuffix & ".pdf" \_ 

    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas \_ 

    :=False, From:=i, To:=i, OpenAfterPublish:=False 

Next i

Answer 1

Further to my previous reply, the following code tests existence of each of the folders and if non-existent, it creates the folder. I did not bother with testing existence of the Users Documents folder because Environ should look after that, and it can be assumed to exist.

Note that the code includes the main sub which I have edited plus a UDF (User Defined Function) to test for the folder existence.

PS. Ensure that you have a backup of your workbook before installing the following code.

Sub PoolPDF() 

' 

' PoolPDF Macro 

' 

Dim UserPath As String:     UserPath = Environ("USERPROFILE") 

Dim rawDate As Date:        rawDate = Sheets("Input").Range("G6").Value 

Dim rDate As String:        rDate = Format(rawDate, "d mmmm yyyy") 

Dim rYear As String:        rYear = Year(rawDate) 

Dim rCycle As String:       rCycle = 1 + Int((rawDate - DateSerial(rYear, 1, 1)) / 28) 

Dim yearPath As String:     yearPath = UserPath & "\Documents\" & rYear 

If FolderExists(yearPath) = False Then  'If False then does not exist 

    MkDir yearPath          'Create the folder if not currently existent 

End If 

Dim cyclePath As String:    cyclePath = yearPath & "\" & rCycle & " - Cycle Ending " & rDate & "\" 

If FolderExists(cyclePath) = False Then 'If False then does not exist 

    MkDir cyclePath         'Create the folder if not currently existent 

End If 

Dim poolPath As String:     poolPath = cyclePath & "Royalty Pool" & "\" 

If FolderExists(poolPath) = False Then  'If False then does not exist 

    MkDir poolPath          'Create the folder if not currently existent 

End If 

'Create individual royalty pool royalty statements 

Dim i As Long 

For i = 1 To 5 

    Dim rName As String 

    If i = 1 Then rName = "Name1" 

    If i = 2 Then rName = "Name2" 

    If i = 3 Then rName = "Name3" 

    If i = 4 Then rName = "Name4" 

    If i = 5 Then rName = "Name5" 

    Dim rSuffix As String: rSuffix = "" 

    If i = 1 Then rSuffix = " Suffix1" 

    If i = 5 Then rSuffix = " Suffix2" 

    'In following line of code: From:=i, To:=i is the page number to save 

    Sheets("Royalty Pool").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 

        poolPath & rName & " - Royalty Pool - Cycle Ending " & rDate & rSuffix & ".pdf" _ 

        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ 

        :=False, From:=i, To:=i, OpenAfterPublish:=False 

Next i 

End Sub 

Function FolderExists(FolderPath As String) As Boolean 

    Dim strFolderExists As String 

    strFolderExists = Dir(FolderPath, vbDirectory) 

    If strFolderExists = "" Then 

        FolderExists = False 

    Else 

        FolderExists = True 

    End If 

End Function

Answer 2

It doesn't get as far as saving any files. The from/to statement is valid.

The macro used to work perfectly. Now it doesn't with no change to my system except for office updates.

Answer 3

It appears that you are saving 5 separate files with each one created from a page of the source. Is this correct?

Does it save any of the 5 files before it errors?

When it errors, before resetting/stopping the macro, hover the cursor over the i in the "From:=i, To:=i" and confirm that it is valid for the number of pages being saved.

Answer 4

It highlights :

Sheets("Royalty Pool").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

poolPath & rName & " - Royalty Pool - Cycle Ending " & rDate & rSuffix & ".pdf" _

, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

:=False, From:=i, To:=i, OpenAfterPublish:=False

Answer 5

Does the code stop and highlight a specific line of code? If so, what line is highlighted?