MailMerge from Excel – 不稳定的macros观行为
下午好，
我已经设置了一个macros来生成基于此线程的个人证书（ 使用Excel VBA自动化邮件合并 ）。 但macros观总是performance不规律，有一天工作，把错误抛给下一个。
我得到的最常见的错误是Excel正在等待另一个应用程序（Word）执行OLE操作。 但有时候会有运行时错误，它不想知道对象。
我已经重新编写了这个macros，希望能够一劳永逸地整理这些问题，但是现在的错误并不像“结束”那样在closuresWord之前。 我有3个“Withs”，那为什么不像3个“With With”呢？ – 我不只是想把“End With”拿出来，因为我觉得对于每个证书都不会打开Word并closures它。 这是问题。
macros被设置为通过Excel工作表，评估列K（r，11），如果它是空的（意味着证书尚未生成），执行mailmerge并将文档保存为PDF到定义的文件夹中。
这是代码。 任何人都可以看到为什么VBA有问题吗？ 谢谢！
Public Sub MailMergeCert() Dim bCreatedWordInstance As Boolean Dim objWord As Word.Application Dim objMMMD As Word.Document Dim FirstName As String Dim LastName As String Dim Training As String Dim SeminarDate As String Dim HoursComp As String Dim Location As String Dim Objectives As String Dim Trainer As String Dim cDir As String Dim r As Long Dim ThisFileName As String FirstName = sh1.Cells(r, 1).Value LastName = sh1.Cells(r, 2).Value Training = sh1.Cells(r, 3).Value SeminarDate = Format(sh1.Cells(r, 4).Value, "d mmmm YYYY") HoursComp = sh1.Cells(r, 5).Value Location = sh1.Cells(r, 6).Value Objectives = sh1.Cells(r, 7).Value Trainer = sh1.Cells(r, 8).Value 'Your Sheet names need to be correct in here Set sh1 = ActiveWorkbook.Sheets("Ultrasound") 'Setup filenames Const WTempName = "Certificate_Ultrasound_2017.docx" 'Template name 'Data Source Location cDir = ActiveWorkbook.Path + "\" 'Change if required ThisFileName = ThisWorkbook.Name On Error Resume Next 'Create Word instance bCreatedWordInstance = False Set objWord = CreateObject("Word.Application") If objWord Is Nothing Then Err.Clear Set objWord = CreateObject("Word.Application") bCreatedWordInstance = True End If If objWord 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 objWord.Visible = False 'Open Word Template Set objMMMD = objWord.Documents.Open(cDir + WTempName) objMMMD.Activate 'Merge the data With objMMMD .MailMerge.OpenDataSource Name:=cDir + ThisFileName, _ sqlstatement:="SELECT * FROM `Ultrasound$`" ' Set this as required lastrow = Sheets("Ultrasound").Range("A" & Rows.Count).End(xlUp).Row r = 2 For r = 2 To lastrow If IsEmpty(Cells(r, 11).Value) = False Then GoTo nextrow With objMMMD.MailMerge 'With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = r - 1 .LastRecord = r - 1 .ActiveRecord = r - 1 End With .Execute Pause:=False End With 'Save new file PDF Dim UltrasoundCertPath As String UltrasoundCertPath = "C:\Users\305015724\Documents\ApplicationsTraining\2016\Ultrasound\" Dim YYMM As String YYMM = Format(sh1.Cells(r, 16).Value, "YYMM") Dim NewFileNamePDF As String NewFileNamePDF = YYMM & "_" & sh1.Cells(r, 3).Value & "_" & sh1.Cells(r, 7).Value '& ".pdf" 'Change File Name as req'd" objWord.ActiveDocument.ExportAsFixedFormat UltrasoundCertPath & NewFileNamePDF, ExportFormat:=wdExportFormatPDF End With ' Close the Mail Merge Main Document objMMMD.Close savechanges:=wdDoNotSaveChanges Set objMMMD = Nothing If bCreatedWordInstance Then objWord.Quit End If Set objWord = Nothing Cells(r, 11).Value = Date 0: Set objWord = Nothing nextrow: Next r End Sub 如果你缩进你的代码，并摆脱“不重要”的东西，你最终这样做：
Public Sub MailMergeCert() '... With objMMMD '... For r = 2 To lastrow '... With objMMMD.MailMerge '... With .DataSource '... End With '... End With '... End With '... Next r End Sub
如果你看看，你很快就会发现你的With / End With块和For / Next循环不匹配。
由于在For循环中只有两个With语句，但是有三个End With语句，所以编译器会“困惑”并坚持纠正错误。