Ошибка времени выполнения 91: переменная объекта или с переменной блока не установлена ​​

Question

У меня есть 2 отдельных текстовых документа с списками слияния. И у меня есть книга Excel с двумя листами. Основываясь на имени рабочего листа &, если лист не пуст, мне нужно отправить mailmerge в соответствующий документ (-ы).

Когда я пытаюсь выполнить этот код, он работает Шифрование до первого документа и во втором документе, он останавливается с ошибкой Run-time Error 91 : Object variable or With block variable not set

Я не уверен, что вызывает эту ошибку (если это переменная Dim или С блоком). Был бы очень признателен, если бы кто-то мог помочь мне исправить эту ошибку.

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 

Answer 1

Как указано Тимом Уильямсом в комментариях к этому вопросу.

У вас есть Set wd = Nothing внутри вашей петли, которая очистит вашу ссылку на Word после первого листа. Переместите это непосредственно перед End Sub