none
Word 2010 VBA: Run-time error '4198' Command Failed - MailMerge

    Question

  • I have written a function in Excel 2010 using VBA that performs a mail merge in Word 2010 using a CSV file that I generated with data from the Excel workbook.

    Function EmailVerstuurd() As Boolean
    
    
    
     Dim appWord As Word.Application
    
     Dim blnRunning As Boolean
    
     Dim doc As Document
    
     Dim strEmailInloggen As String
    
     Dim strRegje As String
    
     Dim i As Integer, rMail As Range
    
     Dim secAutomation As MsoAutomationSecurity
    
     
    
    1 On Error GoTo Err_handler
    
     
    
     'Capture the name of the procedure for debugging purposes
    
    2 strProcedure = "EmailVerstuurd"
    
     
    
     'Full path of mail merge main document
    
    3 strEmailInloggen = "V:\Opleiding\Bedrijfsopleidingen\Typecursus\Procedures\Email inloggegevens nieuwe gebruiker.doc"
    
     
    
     'Check if an instance of Word is already running
    
    4 If modCode.IsAppRunning("Word.Application") Then
    
    5  Set appWord = GetObject(, "Word.Application")
    
    6  blnRunning = True
    
    7 Else
    
    8  Set appWord = CreateObject("Word.Application")
    
    9 End If
    
     
    
     'If necessary set registry key kb825765 / http://vba-corner.livejournal.com/3054.html
    
    10 strRegje = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Word\Options\SQLSecurityCheck"
    
    11 If Not modFunctions.RegKeyExists(strRegje) Then
    
    12  modFunctions.RegKeySave strRegje, "00000000", "REG_DWORD"
    
    13 End If
    
     
    
     'Put security to low kb886633
    
    14 secAutomation = appWord.AutomationSecurity
    
    15 appWord.AutomationSecurity = msoAutomationSecurityLow
    
     
    
     'Open mail merge main document
    
    16 Set doc = appWord.Documents.Open(FileName:=strEmailInloggen)
    
     
    
     'Perform the mail merge - send email to selected recipients
    
    17 With doc.MailMerge
    
    18  .OpenDataSource Name:=ActiveWorkbook.Path & "\" & "Import_TypingMaster.csv"
    
    19  .Destination = wdSendToEmail
    
    20  .MailAsAttachment = False
    
    21  .MailSubject = "Inloggevens online typecursus"
    
    22  .MailAddressFieldName = "student_email"
    
    23  .Execute
    
    24  EmailVerstuurd = True
    
    25  For i = 2 To UBound(varDln, 1)
    
       'Put the date of the sent message in the table with participants
    
    26   Set rMail = ActiveWorkbook.Names("Gegevens").RefersToRange.Columns(1).Find(What:=varDln(i, 1))
    
    27   rMail.Offset(0, 7) = Format(Date, "d-MMM")
    
    28  Next i
    
      'Open the 'standard' DataSource for the mail merge main document
    
    29  .OpenDataSource Name:=ActiveWorkbook.FullName
    
    30 End With
    
     
    
    31 doc.Close SaveChanges:=False
    
    
    
    Exit_Handler:
    
    32 appWord.AutomationSecurity = secAutomation
    
    33 If Not blnRunning Then
    
    34  appWord.Quit
    
    35  Set appWord = Nothing
    
    36 End If
    
     Exit Function
    
     
    
    Err_handler:
    
     MsgBox Err.Description, vbInformation, Err.Number & " regel " & Erl
    
     Resume Exit_Handler
    
    
    
    End Function
    
    

    When I run the code manually, step by step, using F8, everything works fine. When I run the code from the User Form, the code generates error number 4198 stating 'Command Failed'. The error occurs in line 16.

    I have searched several sources, but I cannot find a solution to my problem. What goes wrong?


    Wednesday, June 15, 2011 2:02 PM

Answers

  • Dear Cindy,

    Thanks for your reply. I have tried your suggestion and it seems to work! Only change is I used Resume rather than Resume Next.

    I have declared two additional variables: iErrCounter and iWait and I have adjusted my Err_Handler as follows:

    Err_Handler:
      If Err.Number = 4198 Then
        If iErrCounter <= 5 Then
          'Debug.Print iErrCounter & vbCrLf
          For iWait = 1 To 1000
            DoEvents
          Next iWait
          iErrCounter = iErrCounter + 1
          Resume
        End If
      End If
      MsgBox Err.Description, vbInformation, Err.Number & " regel " & Erl
      Resume Exit_Handler
    

    I have tested a couple of times and the code only runs into the Err_Handler once. So the 1000 DoEvents (appr. 1 second?) apparently do the job...

    Thanks a lot!

    iPillar | Selfmade Office Fiddler

    Thursday, June 16, 2011 1:54 PM

All replies

  • Hi Pillar

    My best guess would be that it's a synchronization problem. Word should run synchronously, but recently more and more things in the application seem to be asynchronous - possibly to make Word faster. But that of course makes life "uncomfortable" for the developer as the object model doesn't really give us any proper way to find out if Word is ready to receive commands.

    How about if you use Resume Next instead of Resume Exit_Handler in your Err_hanlder? (And create a counter that you incrememnt each time the error handler is triggered so that you don't get in an endless loop. When it reaches a certain value, then use Resume Exit_Handler.) Will the line work on the second, third or fourth try?


    Cindy Meister, VSTO/Word MVP
    Thursday, June 16, 2011 12:59 PM
  • Dear Cindy,

    Thanks for your reply. I have tried your suggestion and it seems to work! Only change is I used Resume rather than Resume Next.

    I have declared two additional variables: iErrCounter and iWait and I have adjusted my Err_Handler as follows:

    Err_Handler:
      If Err.Number = 4198 Then
        If iErrCounter <= 5 Then
          'Debug.Print iErrCounter & vbCrLf
          For iWait = 1 To 1000
            DoEvents
          Next iWait
          iErrCounter = iErrCounter + 1
          Resume
        End If
      End If
      MsgBox Err.Description, vbInformation, Err.Number & " regel " & Erl
      Resume Exit_Handler
    

    I have tested a couple of times and the code only runs into the Err_Handler once. So the 1000 DoEvents (appr. 1 second?) apparently do the job...

    Thanks a lot!

    iPillar | Selfmade Office Fiddler

    Thursday, June 16, 2011 1:54 PM