运行时错误91:未设置Object变量或With块变量



我有两个单独的word文档和邮件合并列表。我有一个excel工作簿,有两张纸。基于工作表名称&如果工作表不是空的,我需要将mailmerge发送到相应的word文档。

当我尝试执行此代码时,它会一直运行到第一个文档,在第二个文档,它会以错误Run-time Error 91 : Object variable or With block variable not set 停止

我不确定是什么导致了这个错误(如果是Dim变量或With块)。如果有人能帮我纠正这个错误,我将不胜感激。

Sub Generate_Certificate() 
    Dim wd As Object 
    Dim wdoc_reg As Object 
    Dim wdoc_occ As Object 
    Dim strWbName_reg As String 
    Dim strWbName_occ As String 

    Const wdFormLetters = 0, wdOpenFormatAuto = 0 
    Const wdFormLetters1 = 0, wdOpenFormatAuto1 = 0 
    Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16 
    Const wdSendToNewDocument1 = 0, wdDefaultFirstRecord1 = 1, wdDefaultLastRecord1 = -16 

    On Error Resume Next 
    Set wd = GetObject(, "Word.Application") 
    If wd Is Nothing Then 
        Set wd = CreateObject("Word.Application") 
    End If 
    On Error Goto 0 

    For Each Sheet In ActiveWorkbook.Sheets 
         'Generate report using "Mailmerge" if any data available for Mailmerge1
        If Sheet.Name Like "Sheet1" And IsEmpty(ThisWorkbook.Sheets("Sheet1").Range("A2").Value) = False Then 
            Set wdoc_reg = wd.Documents.Open("C:Mailmerge1.docx") 

            strWbName_reg = ThisWorkbook.Path & "" & ThisWorkbook.Name 

            wdoc_reg.MailMerge.MainDocumentType = wdFormLetters 

            wdoc_reg.MailMerge.OpenDataSource _ 
            Name:=strWbName_reg, _ 
            AddToRecentFiles:=False, _ 
            Revert:=False, _ 
            Format:=wdOpenFormatAuto, _ 
            Connection:="Data Source=" & strWbName_reg & ";Mode=Read", _ 
            SQLStatement:="SELECT * FROM `Sheet1$`" 
            With wdoc_reg.MailMerge 
                .Destination = wdSendToNewDocument 
                .SuppressBlankLines = True 
                With .DataSource 
                    .FirstRecord = wdDefaultFirstRecord 
                    .LastRecord = wdDefaultLastRecord 
                End With 
                .Execute Pause:=False 
            End With 

            wd.Visible = True 
            wdoc_reg.Close SaveChanges:=False 

            Set wdoc_reg = Nothing 
            Set wd = Nothing 
        End If 

         'Generate report using "Mailmerge" if any data available for Mailmerge2
        If Sheet.Name Like "Sheet2" And IsEmpty(ThisWorkbook.Sheets("Sheet2").Range("A2").Value) = False Then 
            Set wdoc_occ = wd.Documents.Open("C:Mailmerge2.docx") 

            strWbName_occ = ThisWorkbook.Path & "" & ThisWorkbook.Name 

            wdoc_occ.MailMerge.MainDocumentType = wdFormLetters1 

            wdoc_occ.MailMerge.OpenDataSource _ 
            Name:=strWbName_Occ, _ 
            AddToRecentFiles:=False, _ 
            Revert:=False, _ 
            Format:=wdOpenFormatAuto1, _ 
            Connection:="Data Source=" & strWbName_occ & ";Mode=Read", _ 
            SQLStatement:="SELECT * FROM `Sheet2$`" 

            With wdoc_occ.MailMerge 
                .Destination = wdSendToNewDocument1 
                .SuppressBlankLines = True 
                With .DataSource 
                    .FirstRecord = wdDefaultFirstRecord1 
                    .LastRecord = wdDefaultLastRecord1 
                End With 
                .Execute Pause:=False 
            End With 

            wd.Visible = True 
            wdoc_occ.Close SaveChanges:=False 

            Set wdoc_Occ = Nothing 
            Set wd = Nothing 
        End If 

    Next 

End Sub

如Tim Williams在问题评论中所述。

循环中有Set wd = Nothing,这将清除第一张纸后对Word的引用。将其移动到End Sub 之前

相关内容

  • 没有找到相关文章

最新更新