I have a macro that exports a worksheet as a PDF file and saves it in the workbook location.
How would I save the PDF file into a folder labelled as the “current year”, eg 2020?
If there is no folder for the current year then one is to be created.
Dim StatementReports_Used As Range
Dim fullFileName As String
Dim saveLocation1 As String
Dim Y As Double
Dim X As Double
Dim year As Integer
year = Format(Date, "yyyy")
Y = DateValue(Now)
X = TimeValue(Now)
Dim dte As Date
dte = Now()
Dim numerical_date
numerical_date = Int(CDbl(dte))
Dim sourceDir As String
sourceDir = "C:\TextFolder\#19"
folder_exists = Dir(sourceDir & "\" & Str(year), vbDirectory)
fullFileName = "Text" & (StatementReports.Range("J20").Value) & "}" & "_" & Y & "_" & X
saveLocation1 = Dir(sourceDir & "\" & Str(year), vbDirectory) & "\" & fullFileName & ".pdf"
StatementReports.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=saveLocation1, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
If folder_exists = "" Then
MkDir sourceDir & "\" & Str(nowdate)
MsgBox "A Folder for the Current Year has been created."
Else
MsgBox "A folder for the Current Year Already exists. Your File will be saved to this."
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
Creating a new folders is easy enough.
dim sourceDir as string
sourceDir = "C:\test_folder"
dim year as int
year = year(now())
' make the dir
mkdir sourceDir & "\" & str(year)
To get the date as an integer just convert it
ie
dim dte as date
dte = now()
dim numerical_date
numerical_date = Int(CDbl(dte))
If you wanted to check if a folder exists first.
folder_exists = Dir(sourceDir & "\" & str(year), vbDirectory)
If folder_exists = "" Then
MsgBox "The selected folder doesn't exist"
Else
MsgBox "The selected folder exists"
End If
That should do the trick for you
EDIT:
Full code as you asked so nicely:)
Sub savePDF():
Dim dte As Date
Dim numericalDate As Integer
Dim sourceDir As String
Dim year As Integer
Dim reportWs As Worksheet
Dim folder_exists As String
Dim fullFileName As String
Dim pdfFileName As String
Dim folderPath As String
Dim filePart As String
'set worksheet as current
Set reportWs = Application.ActiveSheet
''OR
''set reportWs = worksheets("Worksheet_name")
'get year
year = Trim(Str(Format(Date, "yyyy")))
'get date
dte = Now()
'get numerical date
numerical_date = Int(CDbl(dte))
'source directory
sourceDir = "C:\TextFolder\#19"
'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("J20").Value
fullFileName = filePart & numerical_date & " " & Format(Now(), "dd-mm-yyyy HH_MM_SS")
'PDF save locaiton
pdfFileName = folderPath & "\" & fullFileName
'Save PDF
reportWs.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.