简体   繁体   中英

How to save file to current year folder?

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM