2016-01-25 3 views
0

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

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

Дополнительная информация:
Temp1 = Куки шаблон MailMerge слово,
Temp2 = Шоколадные конфеты шаблон MailMerge слово,
Temp3 = Напитки шаблон MailMerge слово
Лист1 = Куки продаж превосходящие данные,
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 
+0

Удалите заявления об ошибках и попробуйте найти, когда именно в настоящее время регистрируется ошибка. Когда вы пытаетесь сохранить, будет ли обрабатываться ваш код, если такое же имя файла уже существует? – Siva

+0

Здравствуйте, когда я удалил оба оператора On Error, код теперь бросает мне «Ошибка времени выполнения» 429: компонент ActiveX не может создать объект ». Какие-либо предложения? –

+0

Укажите строку, в которой произошла эта ошибка. – Siva

ответ

0

Эта ошибка происходит потому, что мой источник первенствовать документ не был сохранен до исполнения 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