只运行Word邮件合并一行

首先让我开始说我不知道​​我在做什么。 那么，有一些想法，但主要是我只是在说。 我一直在研究一个Excelmacros，从Excel运行一个Word邮件合并几个星期，我拼凑了不同的代码，以包含我需要它做的一切。 我的问题是，它第一次工作，但如果我不重置macros，它会卡住每个后续的时间。

我制作的工作表是这样devise的，macros可以从工作表中提取所需的所有信息（代码不包含硬编码位置）。 这是因为包含Excel表单，信函模板和完成信函的文件夹将被发送给多个用户，因此将被保存在每个用户计算机的不同位置。 用户在Excel表格中input详细信息，最终在Word文档中创build格式化的纪律信件，发送给正在审查的玩家。 可能需要在信件中包含多个违规行为，所以Excel表单提供了该选项，而Word表单会包含一堆不必要的空字段。 （我最初尝试在Word中设置字母作为表单，但是我无法获得所有需要一起工作的因素）Word表单也无法隐藏字段并且不能支持依赖项下拉列表或每个下拉列表中的文本数量。 无论如何…

过程：

1. 用户打开Excel文件并将信息input到一个布局合理，用户友好的表单中，该表单包含相关的下拉列表等，以及隐藏和显示字段的button（以防用户需要包含多个违规行为）。
2. 当用户input完信息后，他们点击一个命令button来运行邮件合并（“创build纪律信件”）。
3. 他们在表单中select的信息与另一个名为“数据表”的工作表（相同的工作表）相关联，其中包含合并将从中提取的列。
4. 该工作簿还包含一个“控制表”工作表，该工作表提供macros将从中拉取的文件和文件夹的位置。

macros应该：

1. 打开Word合并模板（它根据用户在表单中select的选项select正确的模板）
2. 运行合并
3. 将合并的产品发送到新文档
4. closures原始合并模板而不保存更改
5. 使用特定的文件名保存新文档（基于用户在原始Excel表单中所做的select）
6. 将其保存到位于我发送给用户的原始文件夹中的“最终文档”文件夹中。
7. 新保存的文件/信件保持打开供进一步编辑（如有必要）
8. 新的文档包含一个button，将完成的信件保存为一个.pdf（也到一个特定的位置），但该macros是在Word中，所以它不是我的问题的一部分。

Excel表格可能会被closures并重新打开，然后用户需要再次使用它，在这种情况下，macros将运行良好。 但是，用户在Word中看到完成的信件，意识到他们忘记了包含违规行为，回到打开的Excel表单添加违规行为，然后再次单击macrosbutton，这是一个很好的可能性。 如果发生这种情况，macros将停留在macros进程＃4以上（从上面的列表中）。 我不知道是什么原因导致了这个问题，但是我一直在和它斗争了好几天，我找不到任何可以应用于我的问题的东西。 或者，也许我有，但我不知道，因为我真的只是在这样做。

Sub RunMerge() Dim bCreatedWordInstance As Boolean Dim wdapp As Word.Application Dim wddoc As Word.Document Dim rng1 As Range Dim wb As Workbook Dim wsControl As Worksheet Dim wsData As Worksheet Dim strWorkbookName As String Dim strTemplateFolder As String Dim strTemplateName As String Dim lngTemplateNameColumn As Long Dim strFinalDocumentFolder As String Dim strFinalDocumentName As String Dim lngDocumentNameColumn As Long Dim lngRecordKount As Long ' not used but retained for future use Set wb = ThisWorkbook Set wsControl = wb.Worksheets("Control Sheet") wsControl.Activate strTemplateFolder = wsControl.[Template_Folder].Value strFinalDocumentFolder = wsControl.[Document_Folder].Value Set wsData = wb.Worksheets(wsControl.[Data_Sheet].Value) wsData.Activate lngTemplateNameColumn = wsData.[Template_Name].Column lngDocumentNameColumn = wsData.[Document_Name].Column Set rng1 = wsData.Range("B1:B8") strTemplateName = strTemplateFolder & "\" & wsData.Cells(2, lngTemplateNameColumn) & ".doc" strFinalDocumentName = strFinalDocumentFolder & "\" & wsData.Cells(2, lngDocumentNameColumn) strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name\ On Error Resume Next ' Create a Word Application instance bCreatedWordInstance = False Set wdapp = GetObject(, "Word.application") If wdapp Is Nothing Then Err.Clear Set wdapp = CreateObject("Word.Application") bCreatedWordInstance = True End If If wdapp Is Nothing Then MsgBox "Could not start Word" Err.Clear On Error GoTo 0 Exit Sub End If ' Let Word trap the errors On Error GoTo 0 ' Set to True if you want to see the Word Doc flash past during construction wdapp.Visible = True ' check that template exists If Dir(strTemplateName) = "" Then MsgBox strTemplateName & " not found" End If Set wddoc = wdapp.Documents.Open(strTemplateName) If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strTemplateName) wddoc.Activate With wddoc .MailMerge.OpenDataSource Name:=strWorkbookName, SQLStatement:="SELECT * FROM `Data Sheet$`" With wddoc.MailMerge 'With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True .Execute Pause:=False End With End With ' Save new file ActiveDocument.SaveAs strFinalDocumentName ' Close the New Mail Merged Document If bCreatedWordInstance Then wddoc.Close savechanges:=wdDoNotSaveChanges Set wddoc = Nothing End If 0: Set wdapp = Nothing Set rng1 = Nothing Set wsData = Nothing Set wsControl = Nothing Set wb = Nothing End Sub 

它第二次卡住了：

 ' Save new file ActiveDocument.SaveAs strFinalDocumentName