Need help with saving a file in a month and year folder

[bpeters1104]

Hi all,

I have an excel document for building support rounds and problems noted throughout the day at work.

I am trying to produce a macro to save this sheet to a specific folder, and in the folder it would find the current year, and create it if non existent. Then inside the year folder, it would look for the current month folder, and of course create it if it doesn't exist. it would then save the file as a pdf in this folder. The path would look something like Z:\Maintenance Turnovers- Support Rounds\year\month\ if done correctly.

I currently have have a macro that works with creating and saving under the "year" path, but i cannot figure out how to include the month then have it save under the month. This is the macro:

Sub savePDF():

Dim dte As Date
Dim numericalDate As Integer
Dim sourceDir As String
Dim year As Integer

Dim mth As Integer
Dim reportWs As Worksheet
Dim folder_exists As String
Dim folder2_exists As String
Dim fullFileName As String
Dim pdfFileName As String
Dim folderPath As String

Dim filePart As String
Dim shiftNumber As String

    
   'set worksheet as current
    Set reportWs = Application.ActiveSheet
    
    ''OR
    ''set reportWs = worksheets("Worksheet_name")
    
    'get year
    year = Trim(Str(Format(Date, "yyyy")))
    
    mth = DatePart("m", Date)
    
    
    
    'get date
    dte = Now()
    
    'get numerical date
    numerical_date = Int(CDbl(dte))
    
    'source directory
    sourceDir = "Z:\Maintenance Turnovers- Support Rounds\"
     
     'check if folder exists, if it doesnt them create a new directory
    folder_exists = Dir(sourceDir & "\" & year, vbDirectory)
    If folder_exists = "" Then
        MkDir sourceDir & "\" & year
        folder_exists = Dir(sourceDir & "\" & year, vbDirectory)
    End If
    
  
    
    'get folder path
    folderPath = sourceDir & "\" & folder_exists
    
    'get filename (I dont think you should use the DATE and TIME as you have as the characters are invalid) Please change below format as you see fit.
    filePart = reportWs.Range("A2").Value
    shiftNumber = reportWs.Range("B2")
    fullFileName = shiftNumber & filePart & " " & Format(Now(), "mm-dd-yyyy")
    
    'PDF save locaiton
    pdfFileName = folderPath & "\" & fullFileName
    
    'Save PDF
    reportWs.ExportAsFixedFormat Type:=xlTypePDF, fileName:=pdfFileName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

Any help is appreciated. Thank you for your time

 

[John_w]

Like this:

    folderPath = "Z:\Maintenance Turnovers- Support Rounds\" & Year(Date) & "\"
    If Dir(folderPath, vbDirectory) = vbNullString Then MkDir folderPath
    
    folderPath = folderPath & Format(Date, "m") & "\"
    If Dir(folderPath, vbDirectory) = vbNullString Then MkDir folderPath

    pdfFileName = folderPath & fullFileName