Search code examples
excelvbainsert

Save PDF file to sub folder based on a cell value

I was having an issue for saving my worksheet as PDF to a folder based on a cell value "M5" + current month text in Arabic language like that (LS WF 28L مارس) and someone here helped me with a simple code and it works perfectly.

And now I want this PDF file to go to a sub folder inside my main folder ("D:\NEWGIZA") based on cell value "M7" as follows:

enter image description here

Sub ExportToPDF()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim Filename As String: Filename = "D:\NEWGIZA\" & ws.Range("M5").Value _
        & " " & Application.Text(Month(Date), "[$-401]mmmm") & ".pdf"
 
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub
Solution

  • Copy to Different Subfolders

    Sub ExportToPDF()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim sName As String
    
    Select Case ws.Range("M7").Value
        Case 1: sName = "NH1 (District One)"
        Case 2: sName = "NH2 (Carnell Park)"
        Case 3: sName = "NH3 (Ivory Hills)" 
        Case 4: sName = "NH4 (Westridge)" 
        Case 5: sName = "NH5 (Gold Cliff)" 
        Case 6: sName = "NH6 (Kingsrange)" 
        Case 7: sName = "NH7 (Amberville)" 
        Case 8: sName = "NH8 (Kingsrange PH2)"
        Case Else:
            MsgBox "Enter a number from 1 to 8 in cell 'M7'!", vbExclamation
            Exit Sub
    End Select
    
    Dim FilePath As String:
    FilePath = "D:\NEWGIZA\" & sName & "\" & ws.Range("M5").Value & " " _
        & Application.Text(Date, "[$-401]mmmm") & ".pdf"
 
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub