Word VBA：將一批 Word 文件轉換為 PDF，並使用每個文檔中表格內容的名稱

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