求教：Word打印PDF设置OutputFileName后PDF文件损坏 - 编程论坛

#2

xia952021-06-26 11:26

回复楼主 xia95

只有本站会员才能查看附件，请登录

#3

xia952021-06-26 12:03

回复楼主 xia95

把OutputFileName:=sf & "\01不动产登记申请书.pdf", PrintTOFile:=True去掉可以正常打印，不过每一个都要手动选择路径保存

#4

厨师王德榜2021-06-28 10:09

可以给你参考一下我的代码:
遍历某文件夹,并将其下所有的 Word文档另存为PDF

程序代码：

Sub Traver_Folder_Save2PDF()
'遍历某文件夹及其下一级子文件夹下文件(非递归方法)
'并将所有Word文档另存为PDF
'Code by:厨师王德榜  2021.6.28
    Dim cPath As String, subPath As String, subFile
    cPath = "c:\XIDE\Plugins\"
    cPath = IIf(Right(cPath, 1) <> "\", cPath & "\", cPath)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder0 = FSO.getfolder(cPath)
    '遍历自身拥有的文件
    If Folder0.Files.Count > 0 Then
        For Each subFile In Folder0.Files
            subFile = (subFile.Name)
            If InStr(1, LCase(subFile), ".doc", vbTextCompare) > 0 Then Save_as_PDF cPath, subFile
        Next subFile
    End If

    If Folder0.subfolders.Count > 0 Then
    Set sfs = Folder0.subfolders
    For Each sf In sfs  '遍历下一级拥有的文件
        subPath = sf.path
        subPath = IIf(Right(subPath, 1) <> "\", subPath & "\", subPath)
      If sf.Files.Count > 0 Then

        For Each subFile In sf.Files
            subFile = (subFile.Name)
            If InStr(1, LCase(subFile), ".doc", vbTextCompare) > 0 Then Save_as_PDF subPath, subFile
        Next subFile

      End If
    Next
    End If
End Sub

Public Sub Save_as_PDF(ByVal paraPath As String, ByVal paraFile As String)
Dim cFout As String, ii As Integer
Dim oleDoc As Object
ii = InStr(1, LCase(paraFile), ".doc", vbTextCompare)
cFout = Left(paraFile, ii - 1) + ".pdf"
cFout = paraPath & cFout
If Len(Dir(paraPath)) > 0 Then
    ChangeFileOpenDirectory (paraPath)

   If Len(Dir(paraPath & paraFile)) > 0 Then
     Set oleDoc = Documents.Open(FileName:=paraFile, _
        ConfirmConversions:=False, _
        ReadOnly:=False, _
        AddToRecentFiles:=False, _
        PasswordDocument:="", _
        PasswordTemplate:="", _
        Revert:=False, _
        WritePasswordDocument:="", _
        WritePasswordTemplate:="", _
        Format:=wdOpenFormatAuto, _
        XMLTransform:="")

      oleDoc.Activate
      If Len(Dir(cFout)) > 0 Then Kill cFout

    oleDoc.ExportAsFixedFormat _
        OutputFileName:=cFout, _
        ExportFormat:=wdExportFormatPDF, _
        OpenAfterExport:=False, _
        OptimizeFor:= _
        wdExportOptimizeForPrint, _
        Range:=wdExportAllDocument, _
        From:=1, To:=1, _
        Item:=wdExportDocumentContent, _
        IncludeDocProps:=True, _
        KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, _
        DocStructureTags:=True, _
        BitmapMissingFonts:=True, _
        UseISO19005_1:=False

        oleDoc.Saved = True
        oleDoc.Close
        Set oleDoc = Nothing
    End If
End If
End Sub