使用新文件名将 Word Doc 转换为 PDF 并附加到新电子邮件

Question

我正在尝试将文档作为 PDF 添加到电子邮件中。我正在尝试更改文件名以包含存储在 Word 文档的 table 中的日期。

我可以创建电子邮件，但脚本在尝试导出时出错。

如何将文件附加为 PDF，文件名的日期取自 Word 中的 table？

Sub CommandButton1_Click()
Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document

Dim DateField       As String
Dim desktoploc      As String
Dim mypath          As String


Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save


'Pull date from table and change format
DateField = Format(Doc.Content.Tables(1).Cell(1, 4).Range.Text, "yyyymmdd")

'Pull line number and subject names from table 1 and table 2 in word to add to subject.
Dim linenum As Word.Range, subject1 As Word.Range, subjec2 As Word.Range

'Need to remove hidden line breaks from tables in word in order to fit on subject line of email
Set linenum = Doc.Content.Tables(1).Cell(1, 2).Range
linenum.MoveEnd unit:=wdCharacter, Count:=-1
Set subject1 = Doc.Content.Tables(2).Cell(2, 1).Range
subject1.MoveEnd unit:=wdCharacter, Count:=-1
Set subjec2 = Doc.Content.Tables(2).Cell(3, 1).Range
subjec2.MoveEnd unit:=wdCharacter, Count:=-1

'Create PDF File
Dim file_name       As String
Dim NewFileName     As String

NewFileName = "Load Limits Subjects " & linenum & " " & DateField

file_name = ActiveDocument.Path & "\" & Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1) & NewFileName & ".pdf"

'This is where I keep getting the error.....

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

   
With EmailItem
    .Display
    .Subject = "Limit Notification - Subject " & linenum & " #line #" & linenum & _
    " #" & subject1.Text & " #" & subjec2.Text & vbCrLf
    .Body = "Please see the attached Limit Notification for Subject " & linenum.Text & vbCrLf & _
    "" & vbCrLf & _
    "Let me know if you have any questions." & vbCrLf & _
    "" & vbCrLf & _
    "Thank you," & vbCrLf & vbCrLf & _
    "INSERT SIGNATURE HERE"
    
'Update Recipient List here:
    .To = "LineEmail@email.com; "
    .CC = "Another Email@demail.com"
    '.Importance = olImportanceNormal
    
    .Attachments.Add Doc.FullName
End With

End Sub

Answer 1

您的代码存在多个缺陷，包括：

您的 DateField 字符串正在尝试将包含 table 单元格结束标记的内容转换为 ISO 格式日期
您的代码未将 NewFileName 字符串验证为文件名。
您的代码试图将文档附加到电子邮件，而不是 pdf。
您的代码在为新文件名创建路径等时引用了 ActiveDocument（它可能不再与 Doc 相同）。

尝试以下方法：

Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document
Dim Rng             As Range
Dim i               As Long
Dim NewFileName     As String
Dim MailSubject     As String
Dim MailBody        As String
Const StrNoChr      As String = """*./\:?|"
NewFileName = " Load Limits Subjects "
MailSubject = "Limit Notification - Subject "
MailBody = "Please see the attached Limit Notification for Subject "

Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)

Set Doc = ActiveDocument
With Doc
  .Save
  Set Rng = .Tables(1).Cell(1, 2).Range
  Rng.End = Rng.End - 1
  NewFileName = NewFileName & Rng.Text & " "
  MailSubject = MailSubject & Rng.Text & " #line #" & Rng.Text & " #"
  MailBody = MailBody & Rng.Text
  Set Rng = .Tables(1).Cell(1, 4).Range
  Rng.End = Rng.End - 1
  NewFileName = NewFileName & Format(Rng.Text, "YYYYMMDD")
  Set Rng = .Tables(2).Cell(2, 1).Range
  Rng.End = Rng.End - 1
  MailSubject = MailSubject & Rng.Text
  Set Rng = .Tables(2).Cell(3, 1).Range
  Rng.End = Rng.End - 1
  MailSubject = MailSubject & Rng.Text
  For i = 1 To Len(StrNoChr)
    NewFileName = Replace(NewFileName, Mid(StrNoChr, i, 1), "_")
  Next
  NewFileName = Split(.FullName, ".doc")(0) & NewFileName & ".pdf"
  SaveAs2 FileName:=NewFileName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
End With


MailBody = MailBody & vbCrLf & _
  "" & vbCrLf & _
  "Let me know if you have any questions." & vbCrLf & _
  "" & vbCrLf & _
  "Thank you," & vbCrLf & vbCrLf & _
  "INSERT SIGNATURE HERE"

With EmailItem
    .Display
    .Subject = MailSubject
    .Body = MailBody
    
'Update Recipient List here:
    .To = "LineEmail@email.com; "
    .CC = "Another Email@demail.com"
    '.Importance = olImportanceNormal
    
    .Attachments.Add NewFileName
End With
End Sub

使用新文件名将 Word Doc 转换为 PDF 并附加到新电子邮件

Convert Word Doc to PDF with new File Name and Attach to New Email

filenames

vba

ms-word