Save certain worksheets as PDFs in a fluid location

[palaeontology]

I currently use the following code to print all worksheets named with a 5-digit name (eg: 34716)

For Each ws In ThisWorkbook.Worksheets    If ws.Name Like "#####" Then
        ws.Range("P22:U22").Font.Color = vbWhite
        ws.Range("P22:U22").Interior.Color = vbWhite
        ws.PageSetup.Orientation = xlLandscape
        ws.PrintOut From:=1, To:=1
    End If
Next ws

I no longer want to print these sheets to paper. I would like to now save each worksheet that is named with a 5-digit code as a PDF to a location such as ...

G:\Maths Dept\STUDENT RESULTS\2019\PDF Profile Copies\CJAMI\12MathA\CHAPMAN, Ellee

however, the last 3 components of that address are fluid, and folders with those names may or may not already exist when the code is run.

In other words, there is definitely a folder at ... G:\Maths Dept\STUDENT RESULTS\2019\PDF Profile Copies .... waiting to receive PDFs, but the "CJAMI\12MathA\CHAPMAN, Ellee" section of the address is dependent on the contents of cells S5, E2 and S3 (in that order) on each of the worksheets that are to be printed (the ones that are named with a 5-digit code).

If, for example, the "CJAMI" folder doesn't already exist inside the location "G:\Maths Dept\STUDENT RESULTS\2019\PDF Profile Copies" then it would need to be created.

and if the "12MathA" folder doesn't already exist inside the "CJAMI" folder, then it would need to be created

etc.

I know that to save as a PDF, the code would have to begin with something like ...

Sheets("Sheet1").Range("A1:H20").ExportAsFixedFormat Type:=xlTypePDF, _    Filename:="C:\Users\marks\Documents\Saved PDF.pdf"

however I really am struggling to figure how to set it up to save in a location with those three fluid components at the end (the ones that are reliant on whatever is in cells S5, E2 and S3 of the sheet being saved in PDF format.

Is this at all possible ?

 

[DanteAmor]

Try this

Change data in red by your information.

Sub Save_worksheets_PDFs()
    Dim ws As Worksheet, wPath As String, r1 As String, r2 As String, r3 As String
    
    wPath = "G:\Maths Dept\STUDENT RESULTS\2019\PDF Profile Copies\"
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "#####" Then
            r1 = ws.Range("S5") & "\"
            r2 = r1 & ws.Range("E2") & "\"
            r3 = r2 & ws.Range("S3") & "\"
            If Dir(wPath & r1, vbDirectory) = "" Then MkDir wPath & r1
            If Dir(wPath & r2, vbDirectory) = "" Then MkDir wPath & r2
            If Dir(wPath & r3, vbDirectory) = "" Then MkDir wPath & r3
            
            ws.Range("P22:U22").Font.Color = vbWhite
            ws.Range("P22:U22").Interior.Color = vbWhite
            ws.PageSetup.Orientation = xlLandscape
            ws.Range([B]"[COLOR=#ff0000]A1:U22[/COLOR]"[/B]).ExportAsFixedFormat xlTypePDF, wPath & r3 & ws.Name & ".pdf"
        End If
    Next ws
End Sub

 

[palaeontology]

Strike that ... everything you wrote works perfectly. I was doing something wrong at my end.

Thankyou again so much for doing that.

It is very much appreciated.

Very kind regards,

Chris

 

[DanteAmor]

Strike that ... everything you wrote works perfectly. I was doing something wrong at my end.

Thankyou again so much for doing that.

It is very much appreciated.

Very kind regards,

Chris

I'm glad to help you. I appreciate your kind comments.