Word 2016下VBA生成PDF与Docx文件报错问题求助

问题原因 #

1. bioPDF这类虚拟打印机不支持通过PrintOut的OutputFileName参数直接指定输出路径，强行这么做会导致生成的PDF文件结构不完整，进而无法被Adobe打开。
2. 打印操作未完成就立刻切换回物理打印机，会中断bioPDF的PDF生成流程，导致文件损坏。
3. 原代码的路径拼接逻辑有漏洞，当用户输入的文件夹本身以斜杠结尾时，会出现重复斜杠的问题，可能影响文件保存路径的正确性。

解决办法 #

推荐方案：改用Word原生PDF导出（更稳定） #

直接用Word内置的ExportAsFixedFormat方法生成PDF，完全避免虚拟打印机的兼容性问题，代码如下：

Sub PrintToPDFAndSaveAsDocx()
    Dim fileName As String
    Dim targetFolder As String
    Dim pdfFullPath As String
    Dim docxFullPath As String
    Dim originalPrinter As String
    
    ' 获取文件名和目标文件夹
    fileName = InputBox("请输入文件名：")
    targetFolder = InputBox("请输入保存文件夹（留空则使用默认路径）：")
    
    ' 处理路径，确保结尾斜杠唯一
    If targetFolder <> "" Then
        If Right(targetFolder, 1) <> "\" Then
            targetFolder = targetFolder & "\"
        End If
    End If
    
    ' 拼接完整路径
    pdfFullPath = "P:\My Documents\" & targetFolder & fileName & ".pdf"
    docxFullPath = "P:\My Documents\" & targetFolder & fileName & ".docx"
    
    ' 保存原始打印机设置
    originalPrinter = Application.ActivePrinter
    
    On Error GoTo Cleanup
    
    ' 用Word原生功能导出PDF
    ActiveDocument.ExportAsFixedFormat _
        OutputFileName:=pdfFullPath, _
        ExportFormat:=wdExportFormatPDF
        
    ' 保存为docx格式
    ActiveDocument.SaveAs2 FileName:=docxFullPath, FileFormat:=wdFormatDocumentDefault
    
Cleanup:
    ' 恢复原始打印机
    Application.ActivePrinter = originalPrinter
    If Err.Number <> 0 Then
        MsgBox "操作出错：" & Err.Description, vbExclamation
    End If
End Sub

必须使用bioPDF的替代方案 #

如果一定要用bioPDF虚拟打印机，需要确保打印完成后再进行后续操作，修改代码如下：

Sub PrintToPDFAndSaveAsDocx()
    Dim fileName As String
    Dim targetFolder As String
    Dim pdfFullPath As String
    Dim docxFullPath As String
    Dim originalPrinter As String
    
    ' 声明Sleep函数，用于等待打印完成
    #If VBA7 Then
        Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    #Else
        Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    #End If
    
    ' 获取文件名和目标文件夹
    fileName = InputBox("请输入文件名：")
    targetFolder = InputBox("请输入保存文件夹（留空则使用默认路径）：")
    
    ' 处理路径，确保结尾斜杠唯一
    If targetFolder <> "" Then
        If Right(targetFolder, 1) <> "\" Then
            targetFolder = targetFolder & "\"
        End If
    End If
    
    ' 拼接完整路径
    pdfFullPath = "P:\My Documents\" & targetFolder & fileName & ".pdf"
    docxFullPath = "P:\My Documents\" & targetFolder & fileName & ".docx"
    
    ' 保存原始打印机设置
    originalPrinter = Application.ActivePrinter
    
    On Error GoTo Cleanup
    
    ' 切换到bioPDF打印机
    Application.ActivePrinter = "PDF Writer - bioPDF"
    
    ' 删除可能存在的旧文件，避免检测错误
    If Dir(pdfFullPath) <> "" Then
        Kill pdfFullPath
    End If
    
    ' 执行打印
    ActiveDocument.PrintOut
    
    ' 等待PDF文件生成
    Do Until Dir(pdfFullPath) <> ""
        DoEvents
        Sleep 500 ' 等待500毫秒，可根据文档大小调整
    Loop
    
    ' 保存为docx格式
    ActiveDocument.SaveAs2 FileName:=docxFullPath, FileFormat:=wdFormatDocumentDefault
    
Cleanup:
    ' 恢复原始打印机
    Application.ActivePrinter = originalPrinter
    If Err.Number <> 0 Then
        MsgBox "操作出错：" & Err.Description, vbExclamation
    End If
End Sub

关键改动说明 #

• 路径处理优化：统一处理文件夹路径的结尾斜杠，避免出现P:\My Documents\test\\file.pdf这类错误路径。
• 打印机状态恢复：添加错误处理块，确保无论操作成功与否，都能恢复到原始打印机设置，不会影响后续使用。
• 等待打印完成（仅bioPDF方案）：通过循环检测文件是否生成，配合Sleep等待，确保bioPDF有足够时间完成PDF的生成和保存，避免中途中断。

内容的提问来源于stack exchange，提问作者someone somewhere sometime