vba - 另存为 PDF，在年月文件夹下

Question

我发现这段代码效果很好，但我需要将 1 张工作簿保存为 pdf。将文件格式更改为 xltypepdf 时不断出错.有人可以帮忙吗。

Sub DateFolderSave() 
Application.DisplayAlerts = False 
' Check for year folder and create if needed If 
Len(Dir("C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date), 
vbDirectory)) = 0 Then 
MkDir "C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) 
End If 
' Check for month folder and create if needed If 
Len(Dir("C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False), vbDirectory)) = 0 Then MkDir 
"C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False)
 End If 
' Check for date folder and create if needed If 
Len(Dir("C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False) & "\" & Format(Date, "dd.mm.yy"), 
vbDirectory)) = 0 Then 
MkDir "C:\Users\Christine\Desktop\Learner Lists LC\" & Year(Date) & "\" & 
MonthName(Month(Date), False) & "\" & Format(Date, "dd.mm.yy") 
End If
 ' Save File 
ActiveWorkbook.SaveAs Filename:= _ "C:\Users\Christine\Desktop\Learner Lists 
LC\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Format(Date, 
"dd.mm.yy") & ".xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, 
CreateBackup:=False 
Application.DisplayAlerts = True 
' Popup Message MsgBox "File Saved As:" &   vbNewLine & 
C:\Users\Desktop\Learner Lists LC\" & Year(Date) & _ "\" & 
MonthName(Month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".xlsm"
End Sub

Answer 1

我做的第一件事(在弄清楚你的代码开始和结束的位置之后)是搜索和替换，使用 1 个变量和 1 个常量(而不是重复 8 次相同的文件夹名称)。

我的侦探技巧告诉我，您是 VBA 的新手:使用常量和变量是第一课，因为它们是“所有编码和开发”的基础。

但是不用担心，每个人都必须从某个地方开始。我重写了你的子程序:

Option Explicit

Sub ExportSheetToPDF()
'exports ActiveWorksheet to dated PDF

    'Set openPDFwhenDone to TRUE to auto-open the PDF when finished
    Const openPDFwhenDone = True

    'Set constant basePath to the file save path
    Const basePath = "C:\Users\Christine\Desktop\Learner Lists LC\"

    'Declare variable pdfPath which for the complete path & filename
    Dim pdfPath As String

    'get the name of the "year" folder
    pdfPath = basePath & Year(Date)

    'if the "year" folder doesn't exist then create it
    If Dir(pdfPath, vbDirectory) = "" Then MkDir pdfPath

    'get the name of the "month" folder
    pdfPath = pdfPath & "\" & Format(Month(Date), "00")

    'if the "month" folder doesn't exist then create it
    If Dir(pdfPath, vbDirectory) = "" Then MkDir pdfPath

    'get the complete pdf filename
    pdfPath = pdfPath & "\" & Format(Date, "yyyy-mm-dd") & ".pdf"

    'export active worksheet as PDF to pdfPath
    ActiveSheet.ExportAsFixedFormat xlTypePDF, pdfPath,,,,,, openPDFwhenDone

    'make sure the pdf file was created
    If Dir(pdfPath) = "" Then
        'file not found
        MsgBox "Something went wrong. (PDF wasn't created.)"
    Else
        'Success!  Show success message (unless PDF was set to auto-open)
        If Not openPDFwhenDoneThen MsgBox "File Saved As:" & vbLf & pdfPath
    End If

End Sub

在我开始挑选之前，我认为“所有代码”所做的不仅仅是找出文件名和导出!注意你的代码的哪些部分被变量 pdfPath 替换了。 .大小可能无关紧要，但效率和易读性才是重要的!

我在上面的代码中添加了很多注释，以便更容易理解，但作为示例，下面的代码几乎相同，只是进一步压缩。实际上创建 PDF 文件只是一行代码。

Sub ExportSheetToPDF_smaller()
    Const basePath = "C:\Users\Christine\Desktop\Learner Lists LC\"
    If Dir(basePath & Year(Date), vbDirectory) = "" Then MkDir basePath & Year(Date)
    If Dir(basePath & Format(Date, "yyyy\\mm"), vbDirectory) = "" Then MkDir basePath & Format(Date, "yyyy\\mm")
    ActiveSheet.ExportAsFixedFormat xlTypePDF, Format(Date, "yyyy\\mm\\yyyy-mm-dd.p\df"), , , , , , True
    MsgBox "File Saved As:" & vbLf & Dir(basePath & Format(Date, "yyyy\\mm\\yyyy-mm-dd.p\df"))
End Sub

所以，作为免费代码的返回，你得到了家庭作业。严重地。请花一些时间浏览下面的链接，将这些命令与上面的代码示例进行比较，因为它们涵盖了使用的每个命令，并且是一个很好的起点。还有很多其他资源(甚至 YouTube 也是一个隐藏的教程库)......

VBA 作业:

VBA Variables & Constants

MSDN: Declaring Constants

MSDN: Declaring Variables

MSDN: Dir function

MSDN: MkDir Function

ExportAsFixedFormat

How to use the FORMAT Function with Dates

MSDN: Format Function

Option Explicit statement

如果您在导出 PDF 时遇到任何问题，请告诉我。

祝你好运!