我在Excel工作簿中有一个宏，它当前执行以下操作：
- 创建前两行有数据的data.csv文件(用于邮件合并(
- 提取所选Word文档的模板，并将data.csv文件作为邮件合并的源
- 如果用户选择，它将完成文档的合并
- 如果用户选择，则会在宏完成后打开文档。如果他们不选择打开，word文档就会全部关闭
我遇到了几个主要问题：
- 只有在Word事先完全关闭的情况下，宏才能顺利运行。我目前的解决方法是，如果Word打开，会弹出一条消息，告诉用户关闭Word，但这并不理想，因为它会干扰一些可能有多个Word打开实例的用户的流程
- 该宏运行缓慢，尤其是对于某些文档模板，该模板中预先输入了数千个合并字段。它有时需要一分钟以上的时间，有时会完全冻结
如果我让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
代替：
Set WordApp = CreateObject("Word.Application")
这将打开Word，如果它还没有打开：
Set WordApp = GetObject(, "Word.Application")
编辑#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
....
....