时间戳

首页 > 解决方案 > 如何将文件保存到当年的文件夹？

excel - 如何将文件保存到当年的文件夹？

问题描述

我有一个将工作表导出为 PDF 文件并将其保存在工作簿位置的宏。

如何将 PDF 文件保存到标记为“当前年份”的文件夹中，例如 2020？
如果当前年份没有文件夹，则将创建一个。

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

标签： excelvba

解决方案

创建一个新文件夹很容易。

dim sourceDir as string
sourceDir = "C:\test_folder"

dim year as int
year = year(now())

' make the dir
mkdir sourceDir & "\" & str(year)

要将日期作为整数获取，只需将其转换

IE

dim dte as date
dte = now()

dim numerical_date
numerical_date = Int(CDbl(dte))

如果您想先检查文件夹是否存在。

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

那应该对你有用

编辑：

你问得很好的完整代码:)

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

推荐阅读