Excel VBA 打印为 PDF - 带有单元格引用文件名和文件夹路径

Question

我正在尝试将 30 页 excel 报告保存/打印为 PDF。
文件和文件夹路径设置为单元格引用。

我尝试使用以下代码，请最后帮我解决问题。

运行时错误“1004”

文档未保存。保存时可能会遇到错误

Sub PrintToPDF()
    Dim ws As Worksheet
    Dim vDir As String
    Dim pdfName As String
    Dim fileSaveName As String
    Dim separator As String: separator = Application.PathSeparator
    Dim FSO As Object

    ' Set the worksheet to print (e.g., "REPORT" sheet)
    Set ws = ThisWorkbook.Sheets("REPORT")

    ' Get the folder path from INPUT!B6
    vDir = ThisWorkbook.Sheets("INPUT").Range("B6").Value

    ' Get the file name from INPUT!B5
    pdfName = ThisWorkbook.Sheets("INPUT").Range("B9").Value

    If vDir = "" Or pdfName = "" Then
        MsgBox "Folder path or file name is missing. Please provide both a folder path and a file name."
        Exit Sub
    End If

    ' Check if the folder exists, and create it if it doesn't
    If Dir(vDir, vbDirectory) = "" Then
        MkDir vDir
    End If

    ' Check if the file name has a ".pdf" extension
    If Right(pdfName, 4) <> ".pdf" Then
        pdfName = pdfName & ".pdf"
    End If

    ' Build the full file path
    fileSaveName = vDir & separator & pdfName

    ' Create a FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Check if the file already exists
    If Not FSO.FileExists(fileSaveName) Then
        ' Set the print area for the "REPORT" sheet (e.g., A1:AK2107)
        ws.PageSetup.PrintArea = "A1:AK2107"

        ' Export the "REPORT" sheet as PDF and open it after publishing
        ws.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileSaveName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        MsgBox "PDF File Saved in " & vDir

        ' Clear the print area setting
        ws.PageSetup.PrintArea = ""
    Else
        MsgBox "This PDF file already exists in the same system folder. or May be Opened"
    End If

    ' Release the FileSystemObject
    Set FSO = Nothing
End Sub

Answer 1

当计算机上不存在该路径名时，会抛出此错误。该方法不会创建不存在的文件夹。首先，您必须创建所有文件夹，然后才能保存文件。必须一个接一个地创建文件夹。

fso.createfolder "C.\users\Username\where\folder1"
fso.createfolder "C.\users\Username\where\folder1\folder2"

然后就可以保存文件了。