平时工作中，经常需要将大量的Word文档转换成PDF，单个转换费时费力，经摸索终于实现一个文件夹内的所有Word文档一次性快速转换的方法，瞬间减轻了工作量，共享如下。

建一个xlsm格式的宏工作簿，将以下代码粘贴到标准模块中即可使用。

Function pth(ykk As String) As String

'确定目录

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Title = ykk

        If .Show = -1 Then

            pth = .SelectedItems(1)

        Else

            Exit Function '没选择目录，退出

        End If

    End With

    '完成确定目录

End Function

Sub WordToPDF()

    Dim mypath As String, dest$, mydoc As Document, temp$

    Dim myFile$, myname$, wdApp As Word.Application

    '----------------------------------------------------------

    mypath = pth("请选择待转换文件所在文件夹")

    dest = pth("请选择目标文件存放目录")

    If mypath = "" Then

        Exit Sub

    End If

    If dest = "" Then

        dest = mypath

    End If

    '----------------------------------------------------------

    myFile = "*.doc*"    '设定文件类型

    myname = Dir(mypath & "\" & myFile)    '取带路径和扩展名的文件名

    Set wdApp = New Word.Application    'New一个Word对象

    Do Until myname = ""    '建立一个循环

        '打开待转换的Word文档赋给对象变量

        Set mydoc = wdApp.Documents.Open(mypath & "\" & myname, ReadOnly:=True)

        '取出不带扩展名的文件名

        temp = VBA.Left(myname, InStrRev(myname, ".") - 1)

        Application.StatusBar = "请稍候，正在转换：" & temp    '状态栏提示

        '转换，各参数的含义可F1

        mydoc.ExportAsFixedFormat OutputFileName:=dest & "\" & temp & ".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

        mydoc.Close False    '关闭已转换完成的Word文档

        myname = Dir    '下一个文档

    Loop

    Application.StatusBar = ""    '置空状态栏

    MsgBox "Word文档已全部转换为PDF文档", 64, "OK"

    Set wdApp = Nothing

End Sub

PDF猫转换器

支持40多种格式转换，高效办公

马上下载