如何用VBA实现Excel导出PDF的覆盖确认及子文件夹检测弹窗

需求实现说明 #

针对「PDF文件已存在时弹出确认替换对话框、目标子文件夹不存在时提示」的要求，对原有VBA代码做如下修改：

修改后的完整代码 #

Sub PrintToPDF()
    Dim strFilename As String
    Dim rngRange As Range
    Dim cust As Range
    Dim strcust As String
    Dim pdfFullPath As String
    Dim custFolderPath As String
    
    ' 获取工作表单元格中的客户名称和PDF文件名
    Set cust = Worksheets("Sheet1").Range("B2")
    Set rngRange = Worksheets("Sheet1").Range("C4")
    strcust = cust.Value
    strFilename = rngRange.Value
    
    ' 构建客户子文件夹路径与PDF文件完整路径
    custFolderPath = "D:\test inv\" & strcust & "\"
    pdfFullPath = custFolderPath & strFilename & ".pdf"
    
    ' 检查客户子文件夹是否存在，不存在则提示并退出
    If Dir(custFolderPath, vbDirectory) = "" Then
        MsgBox "目标路径中的客户子文件夹不存在：" & vbCrLf & custFolderPath, vbExclamation, "文件夹缺失"
        Exit Sub
    End If
    
    ' 检查PDF文件是否已存在，存在则询问是否替换
    If Dir(pdfFullPath) <> "" Then
        If MsgBox("目标PDF文件已存在，是否替换该文件？", vbYesNo + vbQuestion, "文件已存在") = vbNo Then
            Exit Sub
        End If
    End If
    
    ' 执行PDF导出，并处理可能的错误
    On Error Resume Next
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=pdfFullPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    On Error GoTo 0
    
    ' 导出结果提示
    If Err.Number = 0 Then
        MsgBox "PDF文件导出成功！", vbInformation, "完成"
    Else
        MsgBox "PDF导出失败：" & Err.Description, vbCritical, "错误"
    End If
End Sub

关键修改点 #

• 路径拼接修正：原代码直接使用Range对象cust拼接路径，改为使用单元格文本值strcust，避免对象引用导致的路径错误。
• 子文件夹存在性校验：通过Dir函数结合vbDirectory参数判断目标子文件夹是否存在，不存在则弹出提示并终止程序。
• 文件覆盖确认：检查目标PDF文件是否已存在，若存在则弹出Yes/No对话框，用户选择不替换时直接退出流程。
• 错误处理增强：添加异常捕获逻辑，处理导出过程中可能出现的权限不足、文件被占用等问题，并给出对应提示。
• 代码可读性优化：拆分路径为独立变量，使逻辑结构更清晰，便于后续维护。

内容的提问来源于stack exchange，提问作者roy