MS Word 2013 表单，使用宏创建另存为并提交按钮

Posted 2023-05-07

【中文标题】MS Word 2013 表单，使用宏创建另存为并提交按钮

【英文标题】：MS Word 2013 Form, create a Save as and Submit Button with macro

【发布时间】：2017-02-14 23:52:43

【问题描述】：

我在 Word 2013 中有一个简单的表单（来自模板），并有一个“提交”按钮： 1. 从文档中的字段收集信息，为文档命名，并另存为。 2. 通过电子邮件将表单发送到预设的电子邮件地址。

多人将从模板中打开一个文档

Private Sub CommandButton21_Click()
Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document
Dim strTagNum As String, strNTID As String, strDate As String

strTagNum = ActiveDocument.SelectContentControlsByTitle("TagNum")(1).Range.Text
strNTID = ActiveDocument.SelectContentControlsByTitle("NTID")(1).Range.Text
strDate = ActiveDocument.SelectContentControlsByTitle("Date")(1).Range.Text
Dim strFilename As String
strFilename = strTagNum & "_" & strNTID & "_" & Format(strDate, "ddmmyyyy") & ".docx"
StrPath = "V:\OPS\Central\Shared\ARM\ALERT"

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

Doc.SaveAs2 strFilename


With EmailItem
.Subject = "CGF ARM - ALERT ADD/DROP/CHANGE"
.Body = "Please Review this Alert for Continuous Improvement"
.To = "[e-mail]"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With

Application.ScreenUpdating = True

MsgBox "Alert Record Submitted"

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


End Sub

（感谢 Neil Malek 在 knacktraining.com） 还有这个话题Microsoft Word 2013 macro save file name from form content

我的问题是： 1.如何指定saveAs的文件路径？我在宏中有代码，但文档保存在各个用户的 Documents 文件夹中。

如何告诉宏从表单中提取用户名并将其发送到“username”@example.com？

宏的其余部分起作用，当按下“提交”按钮时，文档被重命名、保存并作为电子邮件发送到预设的电子邮件地址。

我已经从原来的问题中更新了这个，通过反复试验，我能够回答我以前的一些问题。

感谢您的宝贵时间。

【问题讨论】：

所以您不想另存为模板？那么你要另存为什么类型的文件呢？

模板将是中心，许多用户从它打开 Document1.docx。我希望将 Document1.docx 保存在特定位置，文件名取自表单。

您需要保存它，包括路径：Doc.SaveAs2 StrPath & "\" & strFilename。最好事先检查文件夹 StrPath 是否存在。还要考虑一些 UNC 路径，而不是 V:，例如 \\FileServerNAS\Documents\ 或 \\YourWorkDomain.com\DFSroot\Site\Documents\ 。或者，添加 CustomDocumentProperties 来存储此路径。

这适用于包括路径，谢谢！我很想使用 UNC 路径，但对于这个应用程序，公司不是这样设置的。

【参考方案1】：

感谢这个有用的链接，我能够挖掘更多内容并解决问题的最后一部分：

excel: reference cell value to get email recipient for selected row?

我最终引用了附加了 & "example.com" 的字段值，然后 .CC 字符串，就像一个魅力！

这是总代码，我是一个非常肤浅的 vba 用户，所以我确信有更清洁的方法，但这似乎可以满足我的需要。

Private Sub CommandButton21_Click()
Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document
Dim strTagNum As String, strNTID As String, strDate As String

strTagNum = ActiveDocument.SelectContentControlsByTitle("TagNum")(1).Range.Text
strNTID = ActiveDocument.SelectContentControlsByTitle("NTID")(1).Range.Text
strDate = ActiveDocument.SelectContentControlsByTitle("Date")(1).Range.Text
Dim strFilename As String
strFilename = strTagNum & "_" & strNTID & "_" & Format(strDate, "ddmmyyyy") & ".docx"
Email_Send_To = strNTID & "@example.com"

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

Doc.SaveAs2 StrPath & "V:\Central\Shared\ARM\ALERT\SubmittedForms\" & strFilename


With EmailItem
.Subject = "Continuous Improvement"
.Body = "Please Review this Alert for Continuous Improvement"
.To = "[e-mail]; [e-mail]; [e-mail]"
.CC = Email_Send_To
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With

Application.ScreenUpdating = True

MsgBox "Alert Record Submitted"

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


End Sub

感谢所有查看并提供有用的代码和 cmets 的人！