在年月文件夹下另存为 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 替换。大小可能无关紧要，但效率和易读性才是重要的！

我在上面的代码中添加了很多 cmets，以便更容易理解，但作为示例，下面的代码几乎相同，只是进一步压缩。实际上创建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 时遇到任何问题，请告诉我。

祝你好运！