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

时间:2017-02-14 23:52:43

标签: forms vba ms-word word-vba save-as

我在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 = "john.doe@example.com"
.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

(感谢Knacktraining.com的Neil Malek)
和这个话题
Microsoft Word 2013 macro save file name from form content

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

  1. 如何告诉宏从表单中提取用户名并将其发送到“username”@ example.com?
  2. 其余的宏工作,当按下“提交”按钮时,文档将被重命名,保存,并作为电子邮件发送到预先设置的电子邮件地址。

    我已经从最初的问题更新了这个问题,我能够通过反复试验回答一些流行的问题。

    感谢您的时间。

1 个答案:

答案 0 :(得分:0)

由于这个有用的链接,我能够挖掘更多并解决问题的最后部分:

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 = "john.doe@example.com; onsiteengr@example.com; chrip@example.com"
.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

感谢所有看过的人以及有用的代码和评论!