Ошибка выполнения 5631

Я пытаюсь создать сертификаты, используя записи из файла основных данных Excel. Мое кодирование выдает мне ошибку VBA «Ошибка выполнения – 5631; Word не может объединить основной документ с источником данных, потому что записи данных были пустыми или никакие записи данных не соответствовали вашим параметрам запроса» каждое дополнительное время.

Для некоторых данных код работает, тогда как большую часть времени он выдает ошибку 5631 в строке .Execute Pause:=False
Внутри файла есть записи, поэтому я знаю, что что-то не так с моим запросом.

Дополнительная информация:
Temp1 = шаблон слова cookie mailmenge,
Temp2 = шаблон шаблона mailmerge шоколада,
Temp3 = шаблон шаблонов mailmerge для напитков
Sheet1 = данные о продажах файлов cookie,
Sheet2 = Премиальные данные о продажах шоколада,
Sheet3 = данные о продажах напитков

Мой полный код:

 Sub Generate_Cert() Dim wd As Object Dim wdoc As Object Dim i As Integer Dim isInvalid As Boolean Dim statement, fileSuffix, datasource As String Dim aSheet As Worksheet Dim cDir As String Dim wdName As String Const wdFormLetters = 0 Const wdOpenFormatAuto = 0 Const wdSendToNewDocument = 0 Const wdDefaultFirstRecord = 1 Const wdDefaultLastRecord = -16 SalesDate = Format(Worksheets("SalesMaster").Cells(2, "B").Value, "DDMMYYYY") On Error Resume Next 'Check Word is open or not Set wd = GetObject(, "Word.Application") If wd Is Nothing Then 'If Not open, open Word Application Set wd = CreateObject("Word.Application") End If On Error GoTo 0 'Getting datasource datasource = ThisWorkbook.Path & "\" & ThisWorkbook.Name 'Looping all sheet from workbook For Each aSheet In ThisWorkbook.Sheets 'If the first cell is not empty If aSheet.Range("A2").Value <> "" Then isInvalid = False 'Check sheet for SQLStatement and save file name. Select Case aSheet.Name Case "Sheet1" statement = "SELECT * FROM `Sheet1$`" fileSuffix = " Cookies Sales" i = 1 Case "Sheet2" statement = "SELECT * FROM `Sheet2$`" fileSuffix = " Chocolates Sales" i = 2 Case "Sheet3" statement = "SELECT * FROM `Sheet3$`" fileSuffix = " Drinks Sales" i = 3 Case Else isInvalid = True End Select 'If sheet should save as word If Not isInvalid Then 'Getting new word document Set wdoc = wd.Documents.Open("C:\Desktop\Sales Certs\Temp" & i & ".docx") With wdoc.MailMerge .MainDocumentType = wdFormLetters .OpenDataSource Name:=datasource, AddToRecentFiles:=False, _ Revert:=False, Format:=wdOpenFormatAuto, _ Connection:="Data Source=" & datasource & ";Mode=Read", _ SQLStatement:=statement .Destination = wdSendToNewDocument .SuppressBlankLines = True With .datasource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With 'wdoc.Visible = True wdName = SalesDate & fileSuffix & ".docx" cDir = ActiveWorkbook.Path + "\" wd.ActiveDocument.SaveAs cDir + wdName MsgBox SalesDate & fileSuffix & " has been generated and saved" 'wdoc.SaveAs Filename:=wdoc.Name wdoc.Close SaveChanges:=True End If End If Next aSheet wd.Quit SaveChanges:=wdDoNotSaveChanges End Sub 

Эта ошибка возникла, потому что мой исходный документ excel не был сохранен до выполнения Mailmerge. Не нужно сохранять документ слова, поскольку перед выполнением Mailmerge не было предварительной обработки.

Поэтому я в основном объявил wBook ​​как книгу и добавил: wBook.Save

 Sub Generate_Cert() Dim wd As Object Dim wdoc As Object Dim i As Integer Dim isInvalid As Boolean Dim statement, fileSuffix, datasource As String Dim wBook As Workbook Dim aSheet As Worksheet Dim cDir As String Dim wdName As String Const wdFormLetters = 0 Const wdOpenFormatAuto = 0 Const wdSendToNewDocument = 0 Const wdDefaultFirstRecord = 1 Const wdDefaultLastRecord = -16 wBook.save '<~~~~~~~ SAVE BEFORE MAILMERGE STARTS SalesDate = Format(Worksheets("SalesMaster").Cells(2, "B").Value, "DDMMYYYY") On Error Resume Next 'Check Word is open or not Set wd = GetObject(, "Word.Application") If wd Is Nothing Then 'If Not open, open Word Application Set wd = CreateObject("Word.Application") End If On Error GoTo 0 'Getting datasource datasource = ThisWorkbook.Path & "\" & ThisWorkbook.Name 'Looping all sheet from workbook For Each aSheet In ThisWorkbook.Sheets 'If the first cell is not empty If aSheet.Range("A2").Value <> "" Then isInvalid = False 'Check sheet for SQLStatement and save file name. Select Case aSheet.Name Case "Sheet1" statement = "SELECT * FROM `Sheet1$`" fileSuffix = " Cookies Sales" i = 1 Case "Sheet2" statement = "SELECT * FROM `Sheet2$`" fileSuffix = " Chocolates Sales" i = 2 Case "Sheet3" statement = "SELECT * FROM `Sheet3$`" fileSuffix = " Drinks Sales" i = 3 Case Else isInvalid = True End Select 'If sheet should save as word If Not isInvalid Then 'Getting new word document Set wdoc = wd.Documents.Open("C:\Desktop\Sales Certs\Temp" & i & ".docx") With wdoc.MailMerge .MainDocumentType = wdFormLetters .OpenDataSource Name:=datasource, AddToRecentFiles:=False, _ Revert:=False, Format:=wdOpenFormatAuto, _ Connection:="Data Source=" & datasource & ";Mode=Read", _ SQLStatement:=statement .Destination = wdSendToNewDocument .SuppressBlankLines = True With .datasource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With 'wdoc.Visible = True wdName = SalesDate & fileSuffix & ".docx" cDir = ActiveWorkbook.Path + "\" wd.ActiveDocument.SaveAs cDir + wdName MsgBox SalesDate & fileSuffix & " has been generated and saved" 'wdoc.SaveAs Filename:=wdoc.Name wdoc.Close SaveChanges:=True End If End If Next aSheet wd.Quit SaveChanges:=wdDoNotSaveChanges End Sub 
  • заселение combobox на основе другого combobox, несоответствие типов
  • Excel VBA - Ошибка выполнения «1004»
  • доступ к подпрограммам один раз, затем Ошибка '91': переменная объекта не задана
  • Ошибка времени выполнения VBA 91 на второй итерации
  • Рисование Rectagles в Excel, Entire Row, «Ошибка времени выполнения:« 1004 »»
  • Ошибка времени выполнения '1004' Этот файл уже открыт в защищенном представлении
  • Авария произошла за пределами виртуальной машины Java в ошибке внутреннего кода при редактировании файлов excel
  • Ошибка времени выполнения VBA 13
  • Ошибка VBA Runtime 1004 on if
  • Ошибка времени выполнения VBA 91. Переменная объекта установки проблемы
  • Ошибка при обращении к предыдущему dimmed activecell (Ошибка времени выполнения «1004»)
  • Давайте будем гением компьютера.