Excel 用于创建 Word 文档并从 Excel 工作簿自动运行邮件合并的工作簿

Question

这里有点棘手。正在尝试简化现有流程。

现有进程：

Word 文档 ("Plan Doc Template") 完全由 INCLUDETEXT 字段组成，这些字段从另一个 Word 文档（"Source Plan Doc" 我们将称之为）中提取书签部分，在其书签部分中包含合并字段来自 Excel 工作簿 ("Mail Merge Workbook")。

当前流程涉及用户复制计划文档模板和邮件合并工作簿并将其粘贴到他们选择的任何文件夹中。然后，用户填写邮件合并工作簿，保存并关闭，然后运行通过计划文档模板 Word 文档进行邮件合并。这会根据所选的邮件合并工作簿字段从源计划文档中提取书签部分。然后，用户使用 CTRL + SHIFT + F9 删除所有 INCLUDETEXT 字段，将 Plan Doc Template 的字段转换为可用文本。

（充满希望）未来进程：

用户复制邮件合并工作簿并将其粘贴到他们的想要的文件夹。填写邮件合并工作簿。（手动步骤）
运行 VBA 代码。
VBA 复制计划文档模板并粘贴到邮件合并工作簿的文件夹中，该文件夹只是运行 VBA 代码。
VBA 根据邮件合并工作簿中的字段重命名计划文档模板 Word 文档。
VBA运行计划文档模板中的邮件合并
VBA 突出显示整个文档并按 CTRL + SHIFT + F9 将域代码转换为可用文本。

是否可以通过 Excel VBA 代码完成所有这些操作，或者在创建计划文档后我需要一个单独的代码来运行邮件合并并执行CTRL + SHIFT + F9 步骤？

P.S。我通过 DDE 选择使用 Excel 工作表来从邮件合并工作簿到文档获得正确的格式。希望也可以包含在 VBA 代码中。

在这方面的帮助将不胜感激，谢谢，

富有

Answer 1

看起来你可以用 Excel 中的一个宏来拥有整个运行，而用户不必运行第二个宏，使用 For 循环直到 wdApp.Documents.Count 增加 1。我确实测试了以下内容，但只有非常小的数据集，所以它运行非常快。

由于用户打开的可能不仅仅是主合并文档，因此代码可以识别并使用生成的文档非常重要。通常，它会变成 ActiveDocument 但依赖于它永远不确定。所以我构建了几个循环来 1) 将当前打开的文档保存在一个数组中，然后 2) 将它们与当前活动的文档进行比较。如果当前活动文档不在数组中，则字段为 unlinked（相当于 Ctrl+Shift+F9）。

当然，如果您真的想从所有文档中识别出新文档，您需要循环每个文档并循环数组，进行比较。但是我已经给了你起点...

Sub MergeWithWord()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim nrDocs As Long
    Dim i As Long, d As Long
    Dim aDocs() As Variant

    Set wdApp = GetObject(, "Word.Application")
    nrDocs = wdApp.documents.Count

    'Get all opened documents so can compare whether a new one
    ReDim Preserve aDocs(nrDocs - 1)
    Set wdDoc = wdApp.activedocument
    For i = 0 To nrDocs - 1
        Set aDocs(i) = wdApp.documents(i + 1)
    Next

    If wdDoc.MailMerge.MainDocumentType <> -1 Then
        wdDoc.MailMerge.Destination = 0
        wdDoc.MailMerge.Execute False
        Do Until wdApp.documents.Count > nrDocs Or i > 1000
            i = i + 1
        Loop
        Set wdDoc = wdApp.activedocument
        For d = 0 To UBound(aDocs)
            If wdDoc Is aDocs(d) Then
                Debug.Print "Not a new doc"
            Else
                Debug.Print wdDoc.FullName
                wdDoc.Fields.Unlink
                Exit For
            End If
        Next
    End If

    Debug.Print nrDocs, i
    MsgBox "Done"

End Sub

Answer 2

可能不是最优雅的代码，但这是我最后用来解决我的问题的代码，以防它对其他人有帮助。

Sub ButtonMerge()
Dim str1 As String
Dim PlanDocTemplate As String
Dim EDrive As String
Dim answer1 As Integer
Dim answer2 As Integer

answer1 = MsgBox("Is this IC Plan Workbook saved in the appropriate Client folder?", vbYesNo + vbQuestion)

If answer1 = vbNo Then
    MsgBox ("Please save this IC Plan Workbook in the appropriate Client folder then run again.")
    Exit Sub
Else
    'do nothing
End If

str1 = "Q:\IC\New Structure\IC Toolkit\Templates Plan Doc Template Source\IC Plan Doc Template v1.0.docx"
PlanDocTemplate = Application.ActiveWorkbook.Path & "\" & Range("A1").Value & ".docx"
EDrive = "E:\" & Range("A1").Value & ".docx"

If Len(Dir(Application.ActiveWorkbook.Path & "\" & Range("A1").Value & ".docx")) = 0 Then
    Call FileCopy(str1, PlanDocTemplate)
Else
    MsgBox ("The Plan document already exists, please delete or rename the existing Plan Doc in folder " _
    & Application.ActiveWorkbook.Path & "\ before creating a new one.")
    Exit Sub
End If

strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Worksheets("Data").Activate

'Opens New Plan Doc Template
Set appWD = CreateObject("Word.Application")
appWD.Visible = True

appWD.Documents.Open Filename:=PlanDocTemplate

ActiveDocument.MailMerge.OpenDataSource Name:=strWorkbookName, _
Format:=wdMergeInfoFromExcelDDE, _
ConfirmConversions:=True, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
Revert:=False, _
Connection:="Entire Spreadsheet", _
SQLStatement:="SELECT * FROM `Data$`", _
SQLStatement1:="", _
SubType:=wdMergeSubTypeOther

appWD.Visible = True

appWD.Selection.WholeStory
appWD.Selection.Fields.Update
appWD.Selection.Fields.Unlink
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
appWD.ActiveDocument.Save

Worksheets("Form").Activate
MsgBox "Successfully Created " & Range("A1").Value & " in Location: " & Application.ActiveWorkbook.Path & "\"

answer2 = MsgBox("Do you want to save a draft in the E:\ drive as well?", vbYesNo + vbQuestion, "E: Drive Copy")

If answer2 = vbYes Then
    If Dir("E:\") <> "" Then
        ActiveDocument.SaveAs2 Filename:= _
        "E:\" & Range("A1").Value & ".docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
        MsgBox ("Successfully Created " & Range("A1").Value & " in E:\ Location.")
        Exit Sub
    Else
        MsgBox ("Please open the E:\ drive and enter your username/password." & _
        vbCrLf & vbCrLf & "Click Ok when E:\ drive is opened.")
        If Len(Dir("E:\")) = 0 Then
            MsgBox ("Error connecting to E:\ drive." & vbCrLf & vbCrLf & "Please ensure you're connected and try again.")
            Exit Sub
        Else
            ActiveDocument.SaveAs2 Filename:= _
            "E:\" & Range("A1").Value & ".docx", _
            FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
            AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
            MsgBox ("Successfully Created " & Range("A1").Value & " in E:\ Location.")
            Exit Sub
        End If
    End If
Else
    Exit Sub
End If

End Sub

Excel 用于创建 Word 文档并从 Excel 工作簿自动运行邮件合并的工作簿

Excel Workbook to Create Word Document and Auto-Run Mail Merge from Excel Workbook

vba

excel

ms-word

mailmerge

Excel 用于创建 Word 文档并从 Excel 工作簿自动 运行 邮件合并的工作簿

Excel Workbook to Create Word Document and Auto-Run Mail Merge from Excel Workbook

vba

excel

ms-word

mailmerge

Excel 用于创建 Word 文档并从 Excel 工作簿自动运行邮件合并的工作簿