Question

尝试组合一个宏，该宏将一批Word文件转换为PDF，其文件名从每个Word文件中的表内容中提取。

我发现一个宏可以将打开的文档转换为具有正确文件名的PDF，另一个宏可以将一批选定的Word文件转换为PDF。

我无法“合并”它们以使PDF具有正确的文件名。任何帮助或建议，将不胜感激！

Sub Open_File_To_PDF()

Dim StrFilename As String  
Dim StrNm As String  
Dim StrCat As String

StrNm = Split(ActiveDocument.Tables(1).Cell(5, 1).Range.Text, vbCr)(0) 
StrCat = Split(ActiveDocument.Tables(1).Cell(2, 1).Range.Text, vbCr)(0) 
StrFilename = StrCat & "_" & StrNm & ".pdf"

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        StrFilename, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, Item:= _
        wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
 End Sub

Sub ConvertDocmInDirToPDF()

Dim filePath As String
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error Resume Next
    filePath = .SelectedItems(1)
End With

If filePath = "" Then Exit Sub
If Right(filePath, 1) <> "\" Then filePath = filePath & "\"

Application.ScreenUpdating = False

Dim currFile As String
currFile = Dir(filePath & "*.docm")

Do While currFile <> ""

    Documents.Open (filePath & currFile)
    Documents(currFile).ExportAsFixedFormat _
        OutputFileName:=filePath & Left(currFile, Len(currFile) - Len(".docm")) & ".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
    Documents(currFile).Close

    currFile = Dir()
Loop

Application.ScreenUpdating = True

End Sub

Answer 1

尝试：

Sub ConvertDocs2PDFs()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      .SaveAs FileName:=Split(.FullName, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Word VBA：将批处理的Word文件转换为具有每个文档中表内容名称的PDF

1 个答案: