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

K

KalilMe

Active Member
Joined
Mar 5, 2021
Messages
399
Office Version
  1. 2016
Platform
  1. Windows
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....
VBA Code: 
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
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
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.

VBA Code: 
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
 
Upvote 0
This line at the end of the code
VBA Code: 
rRowsToHide.Rows.EntireRow.Hidden = True

should be
VBA Code: 
rRowsToHide.Rows.EntireRow.Hidden = False
 
Upvote 0
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 .
 
Upvote 0
This sub does what you asked for.

VBA Code: 
' ----------------------------------------------------------------
' 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..

VBA Code: 
'   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   ~~~~~~  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.
 
Upvote 1
Solution
You must log in or register to reply here.

Similar threads

M
  • Question Question
Need help saving an already open pdf file using name from spreadsheet through VBA
Replies
6
Views
193
MatthewBiersay
M
R
  • Solved
Export excel file as PDF into a targeted pc folder based on cell value
Replies
2
Views
278
Ramadan2512
R
R
  • Solved
Make directory
Replies
6
Views
115
Joe4
Joe4
L
  • Question Question
VBA to save newly created workbook failing - creates a "file" document
Replies
2
Views
238
Sunjinsak
S
N
  • Question Question
Emailing from Excel and automatically attaching pdf
Replies
1
Views
366
dermie_72
D

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top