批量转换成PDF文件

少少飞翔

参考论坛上的大神的文件夹内遍历的方法修改了下，批量转换选定文件夹内的word文件为PDF格式，但是出现个问题解决不了，
问题：当打开word文件第一次运行宏时，选定文件夹内的第一个被转换的word文件转换不成功，其他的word文件都可以转换成功，再第二遍运行宏时，转换失败的那个word文件又可以了，不知道咋回事，大神帮帮看看哪里不对，谢谢
Sub 转换指定文件夹内文档为PDF()
Dim mypathpdf As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then mypathpdf$ = .SelectedItems(1) Else Exit Sub
    End With
    If Right(mypathpdf, 1) <> "" Then mypathpdf = mypathpdf & ""
        Call ListAllFsopdf(mypathpdf)   '调用FSO遍历子文件夹的递归过程
End Sub

Function ListAllFsopdf(mypathpdf$) '用FSO方法遍历所有文件【递归过程】
Dim fld As Object
Dim f As Object
Dim a As Integer
    Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(mypathpdf)
    '用FSO方法得到当前路径的文件夹对象实例 注意这里的【当前路径myPath是个递归变量】
    For Each f In fld.Files  '遍历当前文件夹内所有【文件.Files】
        If f.Name Like "*.docx" Then '指定以.docx字符结尾的文件
            Documents.Open FileName:=f.Path, ConfirmConversions:= _
                False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
                WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" '依次打开word文件
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                Left(f.Name, Len(f.Name) - 5) & ".pdf", 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
            ChangeFileOpenDirectory mypathpdf
            ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
        End If
    Next
End Function

batmanbbs

少少飞翔

batmanbbs 发表于 2023-8-8 17:34

感谢，折腾了一个多小时终于知道哪里错了，我的代码里面没有指定PDF的保存路径。

相见是缘8

batmanbbs 发表于 2023-8-8 17:34

batmanbbs 老师好！

在我这又运行不了，又抄错了那里？

Sub 批量转换Word文档为PDF()

    Dim myPath As String

    WithApplication.FileDialog(msoFileDialogFolderPicker)

         If .Show Then myPath =.SelectedItems(1) & "\" Else Exit Sub

    End With

    Dim oFolder, oFile As Object, myDoc AsDocument

    Set oFolder =CreateObject("Scripting.FileSystemObject").GetFolder(myPath)

    For Each oFile In oFolder.Files

        myPath = LCase(oFile.Path)

        If myPath Like "*.doex" OrmyPath Like "*.doc" Then

            Set myDoc =Documents.Open(FileName:=myPath, ReadOnly:=True)

            myPath = Left(myPath,InStrRev(myPath, ".")) & "pdf"

            myDoc.ExportAsFixedFormatOutputFileName:=myPath, _

                                     ExportFormat:=wdExportFormatPDF

            myDoc.Close

        End If

        Next oFile

    Set oFolder = Nothing

    Set oFile = Nothing

    Set myDoc = Nothing

End Sub

batmanbbs

我估计你根本也没有校对啊，而且运行代码的时候，会有错误的提示

相见是缘8

batmanbbs 发表于 2023-8-9 08:31
我估计你根本也没有校对啊，而且运行代码的时候，会有错误的提示

batmanbbs 老师好！

我每次至少是核对3遍以上，可能还是水平不到……！

过客fppt

太厉害了，非常感谢batmanbbs 老师

1. Sub 批量转换Word文档为PDF()
   
2.     Dim myPath As String
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.          If .Show Then myPath = .SelectedItems(1) & "" Else Exit Sub
   
5.     End With
   
6.     Dim oFolder, oFile As Object
   
7.     Dim myDoc As Document
   
8.     Set oFolder = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
   
9.     For Each oFile In oFolder.Files
   
10.         myPath = LCase(oFile.Path)
    
11.         If myPath Like "*.docx" Or myPath Like "*.doc" Then
    
12.             Set myDoc = Documents.Open(FileName:=myPath, ReadOnly:=True)
    
13.             myPath = Left(myPath, InStrRev(myPath, ".")) & "pdf"
    
14.             myDoc.ExportAsFixedFormat OutputFileName:=myPath, _
    
15.                                      ExportFormat:=wdExportFormatPDF
    
16.             myDoc.Close
    
17.         End If
    
18.         Next oFile
    
19.     Set oFolder = Nothing
    
20.     Set oFile = Nothing
    
21.     Set myDoc = Nothing
    
22. End Sub
    
23. 
    

复制代码

batmanbbs

我记得你使用的WORD是2003，我无法进行测试，不知道是不是版本太低的缘故。
PS: 文件扩展名你还是没有改过来啊，应该是docx

====================

刚刚查了一下，好像是2010开始有这个方法的，你试试看你的2003能够另存成PDF吗？如果可以，试试修改成一下语句：

413191246se

相见：代码不用抄！华为手机+百度，能把图片上的文字提取转换为普通文字，再校对一下，对试验文本进行试运行（注意：将正式文件打包备份并测试）。

batmanbbs

413191246se 发表于 2023-8-9 11:21
相见：代码不用抄！华为手机+百度，能把图片上的文字提取转换为普通文字，再校对一下，对试验文本进行试运 ...

因为论坛发布代码需要审核，而且审核时间比较长，所以我一般都是直接发布代码截图。如果代码很长，我会再发布文本代码。

如果哪位需要我的文本代码，不论长短，都可以直接联系我索取。而且，后期我一般都会根据实际情况再处理一些小BUG，对代码进一步完善。