如何从 Excel 运行 Word 邮件合并宏？

Question

我的 Excel 工作簿中有一个宏，当前执行以下操作：

1. 创建一个包含前两行数据的 data.csv 文件（用于邮件合并）
2. 提取所选 Word 文档的模板并将 data.csv 文件作为源对于邮件合并
3. 如果用户选择，它会完成文档的合并
4. 如果用户选择，它会在宏完成时打开文档。如果他们不选择打开，Word 文档将全部关闭。

我遇到了几个主要问题：

1. 只有在事先完全关闭 Word 的情况下，宏才能顺利运行。我当前的解决方法是，如果 Word 打开，则会弹出一条消息，告诉用户关闭 Word，但这并不理想，因为它会扰乱某些可能打开多个 Word 实例的用户的流程。
2. 该宏运行缓慢，特别是对于某些在模板中预先输入了数千个合并字段的文档模板。有时需要超过一分钟，有时会完全冻结。

如果我让 Excel VBA 打开 Word 模板，并且在 Word VBA 中拥有用于设置和完成邮件合并的大部分代码，宏会运行得更顺畅吗？我对 Word VBA 不太熟悉 - 任何人都可以帮助我将代码转换为 Word（但仍然由 Excel 启动）吗？另外，如果您能弄清楚为什么当 Word 已经打开时宏会陷入困境，我将不胜感激。

出于专有原因，我没有包含完整的代码，但如果您还需要查看其他内容，请告诉我。

谢谢你！！

Sub Mail_Merge_Dynamic()
    Dim mergeFile, tempFilePath As String
    Dim WordDoc, WordApp As Object
    Dim tempPath, mergePath, finalPath, curDir As String
    Dim mergeFilePath, finalFilePath As String
    Dim dataPath, FileNameCell, PrincCertCell, MMPrefix As String
    Dim FileCount As Integer
    Dim Close_Choice, ActiveWindow As String
    Dim WarningMsg, WarningMsg2 As String
    Dim NotFound, Overwrite1, Overwrite2 As Boolean
    
Dim oBook As Workbook

'Update csv file for Data Merge
    narrative_merge
    Call WarpSpeed_On
    Sheets("Navigation").Select
    Range("Merge_File_1").Select
    
    Set WordApp = CreateObject("Word.Application")
    
'//////////////////////////////MAIL MERGE MACRO\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Set up Mail Merge Documents from Template Folder based on selections on Navigation tab
    For i = 1 To FileCount
        FileNameCell = "Merge_File_" & i
        If Range(FileNameCell) = "" Then
        Else
            mergeFile = Range(FileNameCell)
            
           
            tempFilePath = tempPath & mergeFile
    
            mergeFilePath = mergePath & "MM_" & mergeFile
            finalFilePath = finalPath & mergeFile
                
'Activate Mail Merge
            If Range("MM_Activate") = 0 Then
            Else
                Set WordDoc = WordApp.Documents.Open(tempFilePath)
                
                With WordDoc.MailMerge
                    .MainDocumentType = wdFormLetters
        
                'Set up the mail merge data source
                    dataPath = curDir & "\data.csv"
                    .OpenDataSource Name:=dataPath
                    
                'Show values in the mail merge fields
                    .ViewMailMergeFieldCodes = wdToggle
                End With
                
                'WordDoc.ShowFieldCodes = False
                'WordDoc.MailMerge.ViewMailMergeFieldCodes = False
                
                WordDoc.SaveAs FileName:=mergeFilePath
        
            End If
              
' Finish mail merge
            If Range("MM_Finish") = 0 Then
            Else
                With WordDoc.MailMerge
                    .Destination = wdSendToNewDocument
                    .SuppressBlankLines = True
                    .Execute Pause:=False
                End With
            
                WordDoc.Application.ActiveDocument.SaveAs finalFilePath
            End If
                
        End If
    Next i
       
Call CloseWordDocuments
    
'Make word visible if an Open command has been selected
If Range("MM_Open_Merge") = 1 Or Range("MM_Open_Doc") = 1 Then
    curDir = ThisWorkbook.Path
    Set WordApp = CreateObject("Word.Application")
    
    For i = 1 To FileCount
        FileNameCell = "Merge_File_" & i
        If Range(FileNameCell) = "" Then
        Else
        
        mergeFile = Range(FileNameCell)
          
        mergeFilePath = curDir & "\Merge-Active Forms\" & "MM_" & mergeFile
        finalFilePath = curDir & "\Merge-Complete Forms\" & mergeFile
            
            If Range("MM_Open_Merge") = 1 Then
                Set WordDoc = WordApp.Documents.Open(mergeFilePath)
            End If
            
            If Range("MM_Open_Doc") = 1 Then
                Set WordDoc = WordApp.Documents.Open(finalFilePath)
            End If
        End If
    Next i
    
    WordApp.Visible = True
    'Windows(mergeFile).Activate
    
End If

GoTo Reset
Reset:
Call WarpSpeed_Off
      

End Sub


Sub WarpSpeed_On_Calcs_Off()

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
' Turn off display alerts
  Application.DisplayAlerts = False
End Sub

Sub WarpSpeed_On()

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  
' Turn off display alerts
    Application.DisplayAlerts = False

End Sub


Sub WarpSpeed_Off()

'Reset Macro Optimization Settings
   Application.EnableEvents = True
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

而不是：

Set WordApp = CreateObject("Word.Application")

这将打开 Word（如果尚未打开）：

Set WordApp = GetObject(, "Word.Application")

Edit#1

在 VBA 中，您可以执行以下操作：

  On Error GoTo CreateObj
  ' Is Word application already running ?
  Set WordApp = GetObject(, "Word.Application")
  GoTo gotApp
CreateObj:
  ' Not running, create first instance:
  Set WordApp = CreateObject("Word.Application")
gotApp:
  On Error GoTo 0 ' disable error handling
  ' continue
  ....
  ....