Question

我已根据反馈对问题进行了编辑。我有一个表单，我希望用户能够一键单击即可无提示地保存（无需用户输入）并发送。

以下代码将以正确的名称另存为.pdf，与原始文件位于同一文档/路径中（我想要）。但是，发送电子邮件时，附件将是原始的.docm文件。

最终附件必须为.pdf，因为它将通过电子邮件发送到Microsoft Team网站，并且启用宏的文件在Teams上不起作用。

除了对自己的工作流程使用基本命令外，我还是VBA新手。我正在研究各种教程/课程以及一本关于vba for Office的超大型书籍，但我希望尽快解决我的新手编码错误。

Private Sub btnSubmit_Click()

strName = ActiveDocument.SelectContentControlsByTitle("ddName")(1).Range.Text
strDate = ActiveDocument.SelectContentControlsByTitle("ddDate")(1).Range.Text
strTest = ActiveDocument.SelectContentControlsByTitle("ddTestNumber")(1).Range.Text

Dim strFilename As String
strFilename = strName & "_" & "VBATestFile_" & strTest & "_" & Format(strDate, "yyyymmdd") & ".pdf"

ActiveDocument.SaveAs2 strFilename, FileFormat:=wdFormatPDF

Dim OL          As Object
Dim EmailItem   As Object
Dim Doc         As Document

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

With EmailItem
    .Subject = strName & " Test" & strTest
    .Body = "Test email send for " & strName & " " & strTest & "."
    .To = "email address here"
    .Importance = olImportanceNormal
    .Attachments.Add Doc.FullName
    .Send
End With

Application.ScreenUpdating = True

MsgBox "Form Submitted", vbInformation

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

End Sub

Answer 1

已解决：

Private Sub btnSubmit_Click()

strName = ActiveDocument.SelectContentControlsByTitle("ddName")(1).Range.Text
strDate = ActiveDocument.SelectContentControlsByTitle("ddDate")(1).Range.Text
strTest = ActiveDocument.SelectContentControlsByTitle("ddTestNumber")(1).Range.Text

Dim strFilename As String 'Create Filename based on data in Content Controls  
strFilename = strName & "_" & "VBATestFile_" & strTest & "_" & format(strDate, "yyyymmdd") & ".pdf"

ActiveDocument.SaveAs2 strFilename, FileFormat:=wdFormatPDF 'Save as .pdf to Documents folder

Dim OL          As Object
Dim EmailItem   As Object
Dim Doc         As Document

Dim sPathUser As String 'Get current file path
sPathUser = Environ$("USERPROFILE") & "\my documents\"

Application.ScreenUpdating = False 'Silently send email with .pdf file attached
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save

With EmailItem
    .Subject = strName & " Test " & strTest
    .Body = "Test email send for " & strName & " " & strTest & "."
    .To = "email address"
    .Importance = olImportanceNormal
    .Attachments.Add strFilename
    .Send
End With

Application.ScreenUpdating = True

MsgBox "Form Submitted", vbInformation 'Confirm document submission for user

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

End Sub

如何：附加.pdf并发送电子邮件而无需用户输入

1 个答案: