create folder for current year & months to save files as pdf

[KalilMe]

Hello
I need modifying code by create folders(year ) & create folders(month ) inside folders(year ) into this directory "C:\Users\kl\Desktop\invoices" based on date are existed in cell G5 and save the pdf files in month folders into folders(year ) based on G5. and should replace the file every time run the macro .
the month folders names should be JAN,FEB....

Public Sub Save_PDF1()

    Dim Nm As String
    Dim Rng As Range
    Dim hideRowsRange As Range, r As Long
   
    Set Rng = Range("A1:G44")     '<- Set your range here
    Set hideRowsRange = Range("A21:G34")
   
    For r = 1 To hideRowsRange.Rows.Count
        If Application.CountA(hideRowsRange.Rows(r)) = 0 Then hideRowsRange.Rows(r).EntireRow.Hidden = True
    Next
   
    Nm = ActiveWorkbook.FullName
    Nm = Left(Nm, InStrRev(Nm, ".") - 1) & Format(Now, " yyyymmddhhmmss") & ".pdf"
   
    Rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Nm, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=True

    For r = 1 To hideRowsRange.Rows.Count
        If Application.CountA(hideRowsRange.Rows(r)) = 0 Then hideRowsRange.Rows(r).EntireRow.Hidden = False
    Next

End Sub

 

[OaklandJim]

I hope that this helps. As usual, typically other smarter Excelers give better solutions. If nothing else, my code tends to be too long and klunky.

Option Explicit

Public Sub SavePDF()

    Dim sWorkbookName As String
    
    Dim wsDataSheet As Worksheet
    
    Dim sPDFFileName As String
    
    Dim sPath As String
    
    Dim sFolderForPDFs As String
    
    Dim rRangeToInclude As Range
    
    Dim rRowsToHide As Range
    
    Dim iRow As Long
    
    Dim sUserName As String
    
    Set wsDataSheet = ThisWorkbook.Worksheets("Sheet1") '<- Set your worksheet

    sFolderForPDFs = "Invoices"
    
'   Get workbook name without file extension.
    sWorkbookName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    
'   Specify pdf file name.
    sPDFFileName = sWorkbookName & Format(Now, " yyyymmddhhmmss") & ".pdf"
    
'   Set range to include in the pdf.
    Set rRangeToInclude = wsDataSheet.Range("A1:G44")     '<- Set your range here

'   Set range of rows to hide if the cell in column A is empty.
    Set rRowsToHide = wsDataSheet.Range("A21:G34")

'   Specify user name.
    sUserName = "Jim"  '<= put user name here (e.g., kl)

'   Hide rows where the cell in the first column of rRowsToHide is empty.
    For iRow = 1 To rRowsToHide.Rows.Count
        If rRowsToHide.Cells(iRow, 1).Value = "" _
         Then
            rRowsToHide.Rows(iRow).EntireRow.Hidden = True
        End If
    Next

'   If the path with the specified user name does not exist then tell user and exit sub.
    sPath = "C:\Users\" & sUserName & "\"
    
    If Dir(sPath, vbDirectory) = "" _
     Then
        MsgBox "The path " & sPath & " does not exist.", vbCritical
        Exit Sub
    End If
   
'   If the desktop folder for the specified user name does not exist then tell user and exit sub.
    sPath = "C:\Users\" & sUserName & "\Desktop\"

    If Dir(sPath, vbDirectory) = "" _
     Then
        MsgBox "The path " & sPath & " does not exist.", vbCritical
        Exit Sub
    End If
    
'   If the target folder for PDFs does not exist in desktop folder then create it.
    sPath = "C:\Users\" & sUserName & "\Desktop\" & sFolderForPDFs & "\"
    
    If Dir(sPath, vbDirectory) = "" _
     Then
        MkDir sPath
    End If

    rRangeToInclude.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=sPath & sPDFFileName, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=True, _
        OpenAfterPublish:=False
        
    rRowsToHide.Rows.EntireRow.Hidden = True

End Sub

 

[OaklandJim]

This line at the end of the code

rRowsToHide.Rows.EntireRow.Hidden = True

should be

rRowsToHide.Rows.EntireRow.Hidden = False

 

[KalilMe]

thanks
you seem to don't understand me what I want it!
should create folder based current year in INVOICES folder to become C:\Users\kl\Desktop\invoices\INVOICES_2023\"
and create months folders based on current month inside INVOICES_2023 folder , for instance the current month is JULY then should be C:\Users\kl\Desktop\invoices\INVOICES_2023\INVOICE_JULY\"
and save the file as PDF inside INVOICE_JULY folder.
I hope this details help you .

 

[OaklandJim]

This sub does what you asked for.

' ----------------------------------------------------------------
' Procedure Name: SavePDF
' Purpose: Create PDF named based on this workbook in invoices => year => month folder
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jim
' Date: 6/8/2023
' ----------------------------------------------------------------

Public Sub SavePDF()

'   -----------------------------
'          Declarations
'   -----------------------------

    Dim sWorkbookName As String
    
    Dim wsDataSheet As Worksheet
    
    Dim sPDFFileName As String
    
    Dim sPath As String
    
    Dim sInvoicesFolderName As String
    
    Dim rRangeToInclude As Range
    
    Dim rRowsToHide As Range
    
    Dim iRow As Long
    
    Dim sUserName As String
    
    Dim iYear As Long
    
    Dim sMonthName As String
    
    Dim bOpenPDF As Boolean
    
'   -----------------------------
'       User Specified Values
'   -----------------------------

'   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   ~~~~~~  These five values must be set by the user   ~~~~~~
'   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
'   Specify user name.
    sUserName = "Jim"  '<= put user name here (e.g., kl)

'   Point worksheet object wsDataSheet to the sheet with data.
    Set wsDataSheet = ThisWorkbook.Worksheets("Sheet1") '<- Set your worksheet

'   Set range to include in the pdf.
    Set rRangeToInclude = wsDataSheet.Range("A1:G44")     '<- Set your range here

'   Set range of rows to hide if the cell in column A is empty.
    Set rRowsToHide = wsDataSheet.Range("A21:G34")
    
'   Indicate whether to open the PDF file after it is created.
    bOpenPDF = False '<= change to True if you want the PDF to open after it is created.

'   -----------------------------
'       Other Initializations
'   -----------------------------

'   Get current year and month
    iYear = Year(Now())
    sMonthName = MonthName(Month(Now()))
    
'   Name of "top" folder for invoices.
    sInvoicesFolderName = "Invoices"
    
'   Get workbook name without file extension.
    sWorkbookName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    
'   Specify pdf file name.
    sPDFFileName = sWorkbookName & Format(Now, " yyyymmddhhmmss") & ".pdf"

'   -----------------------------
'         Hide Empty Rows
'   -----------------------------

'   Hide rows where the cell in the first column of rRowsToHide is empty.
    For iRow = 1 To rRowsToHide.Rows.Count
        If rRowsToHide.Cells(iRow, 1).Value = "" _
         Then
            rRowsToHide.Rows(iRow).EntireRow.Hidden = True
        End If
    Next

'   ----------------------------
'       Manage Directories
'   ----------------------------

'   If the path with the specified user name does not exist then tell user and exit sub.
    sPath = "C:\Users\" & sUserName & "\"
    
    If Dir(sPath, vbDirectory) = "" _
     Then
        MsgBox "The path " & sPath & " does not exist.", vbCritical
        Exit Sub
    End If
   
'   If the desktop folder for the specified user name does not exist then tell user and exit sub.
    sPath = "C:\Users\" & sUserName & "\Desktop\"

    If Dir(sPath, vbDirectory) = "" _
     Then
        MsgBox "The path " & sPath & " does not exist.", vbCritical
        Exit Sub
    End If
    
'   If the invoices folder for PDFs does not exist in desktop folder then create it.
    sPath = "C:\Users\" & sUserName & "\Desktop\" & sInvoicesFolderName & "\"
    
    If Dir(sPath, vbDirectory) = "" _
     Then
        MkDir sPath
    End If
    
'   If the year folder for PDFs does not exist in the invoices folder then create it.
    sPath = "C:\Users\" & sUserName & "\Desktop\" & sInvoicesFolderName & "\" & "INVOICES_" & iYear & "\"
    
    If Dir(sPath, vbDirectory) = "" _
     Then
        MkDir sPath
    End If
    
'   If the month folder for PDFs does not exist in year folder in the invoices folder then create it.
    sPath = "C:\Users\" & sUserName & "\Desktop\" & sInvoicesFolderName & "\" & "INVOICES_" & iYear & "\" & "INVOICES_" & sMonthName & "\"
    
    If Dir(sPath, vbDirectory) = "" _
     Then
        MkDir sPath
    End If
    
'   ----------------------------
'        Save the pdf File
'   ----------------------------

    rRangeToInclude.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=sPath & sPDFFileName, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=True, _
        OpenAfterPublish:=bOpenPDF
        
    rRowsToHide.Rows.EntireRow.Hidden = False

End Sub

Make sure to set these variables to match your system and preference regarding opening pdf file after it is created..

'   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   ~~~~~~  These five values must be set by the user   ~~~~~~
'   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
'   Specify user name.
    sUserName = "Jim"  '<= put user name here (e.g., kl)

'   Point worksheet object wsDataSheet to the sheet with data.
    Set wsDataSheet = ThisWorkbook.Worksheets("Sheet1") '<- Set your worksheet

'   Set range to include in the pdf.
    Set rRangeToInclude = wsDataSheet.Range("A1:G44")     '<- Set your range here

'   Set range of rows to hide if the cell in column A is empty.
    Set rRowsToHide = wsDataSheet.Range("A21:G34")
    
'   Indicate whether to open the PDF file after it is created.
    bOpenPDF = False '<= change to True if you want the PDF to open after it is created.

 

[KalilMe]

my code tends to be too long and klunky

no problem . the most important works, and it's so .
many thanks for your help.