使用VBA将批量的WORD文档转换为PDF

Sub BatchConvertToPDF()
    Dim destFolderPath As String
    destFolderPath = GetFolderPath
    If destFolderPath <> Empty Then
        Dim path As Variant
        For Each path In GetFilePaths()
            Dim indexOfSlash, indexOfDot As Integer
            indexOfSlash = InStrRev(path, "\")
            indexOfDot = InStrRev(path, ".")
            
            Dim destFilePath As String
            destFilePath = destFolderPath + Mid(path, indexOfSlash, indexOfDot - indexOfSlash) + ".pdf"
            
            ConvertToPDF path, destFilePath
        Next path
    End If
End Sub

Function GetFilePaths()
    Dim folderPath As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Add "word文件", "*.doc; *.dotx; *.docm"
        .Title = "请择要转换的word文件"
        If .Show = -1 Then
            Set GetFilePaths = .SelectedItems
        End If
    End With
End Function

Function GetFolderPath()
    Dim folderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "请选择要存放的目录"
        If .Show = -1 Then
            GetFolderPath = .SelectedItems(1)
        End If
    End With
End Function

Sub ConvertToPDF(srcPath As Variant, destPath As String)
    Documents.Open FileName:=srcPath, ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        destPath, ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForOnScreen, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
    ActiveDocument.Close
End Sub

  

转载于:https://www.cnblogs.com/beta2013/p/3666077.html

  • 0
    点赞
  • 9
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值