vbams-accessms-word

How do I get my Mailmerge VBA routine not to show dialog box and to run automatically


I am using Office 2016 to try and automatically send emails using VBA.

The routines export 1 record at a time to a spreadsheet and the Word mailmerge is invoked using the spreadsheet.

The Word document is then saved as a PDF and the email sent containing the PDF.

The problem I am having is that the routine keeps producing the same dialog box for every record and I would like it to run automatically.

The error I am getting is

Dialog box

The code I am using is

acExport, _ 
acSpreadsheetTypeExcel12Xml, _ 
"Updatedetailsone", _ 
mailmergexls, True 

' 
' Merge Word document with mailmerge spreadsheet file 
' 

Set wordApp = CreateObject("Word.Application") 
wordApp.Visible = True 

Set wordDoc = wordApp.Documents.Open(mailmergedoc) 
With wordDoc.MailMerge 
  .MainDocumentType = wdMailingLetters 
  .OpenDataSource Name:=mailmergexls, _ 
  ConfirmConversions:=False, _ 
  ReadOnly:=False, _ 
  LinkToSource:=False, _ 
  AddToRecentFiles:=False, _ 
  Connection:="Updatedetailsone" 
  .Destination = wdSendToNewDocument 
  .Execute 
  .MainDocumentType = wdNotAMergeDocument 
End With 

' 
' Delete existing membership form PDF file 
' Create new membership form PDF file with current record 
' 

Kill mailmergepdf 

wordApp.ActiveDocument.SaveAs2 mailmergepdf, 17 
' 
' Close and clean up Word documents 
' 
For Each wordDoc In wordApp.Documents 
  wordDoc.Close SaveChanges:=False 
  Next wordDoc 
wordApp.Quit 

Set wordDoc = Nothing 
Set wordApp = Nothing

Any help will be appreciated.

I would like the routine to automatically select the 1st table without prompting.


Solution

  • I originally meant to say more about how you can connect directly to an Access table from a Word mail merge main document.

    It's not straightforward, because when you are developing, Word often reports that it can't connect to the data because someone has put the database into a certain state. One thing that causes that is any change to a VBA module, which means that you have to save the database before testing any change you make in the code (and although you would probably know if you were using a 3rd party VB Editor addin, be aware that they can also make changes "behind the scenes"). Access will try to "promote" a lock to "Exclusive" primarily to ensure that design changes are not blocked when you try to save the change - for further info., see e.g. this

    I also find that when you update table data in Access VBA in the CurrentDB, Access tends to lock stuff. It might be possible to work around that by using a connection file in your Word .OpenDataSource call that specifies a suitable open option (shared read only or something like that). However, another way to avoid that problem is to create a table in a different .accdb file and use that as your data source. So the following code is my suggestion for how you can do that to avoid going via Excel.

    This part doesn't cover the bit where you automate Outlook, but perhaps you can avoid multiple invocations to CreateObject by copying my approach.

    BTW this is not well tested and I'm sure a regular Access VBA coder could improve the code.

    You'll need to create an Access DB .accdb - in my example it is called in c:\a\tempdb.accdb, and you'll need to modify the other constant values.

    Option Compare Database
    
    Const TempDBFullName As String = "c:\a\tempdb.accdb"
    Const RSAllName As String = "Updatedetailsall"
    Const RSOneName As String = "Updatedetailsone"
    Const JuniorMMMDFullName As String = "c:\a\junior.docx"
    Const AdultMMMDFullName As String = "c:\a\adult.docx"
    Const MailMergePDF As String = "c:\a\merged.pdf"
    Sub mysub()
    
    Dim wordApp As Word.Application ' Object if you are using late binding
    Dim wordDoc As Word.Document ' Object
    ' MMMD = Mail Merge Main Document
    Dim JuniorMMMD As Word.Document ' Object
    Dim AdultMMMD As Word.Document ' Object
    On Error GoTo problem
    
    Set RSAll = CurrentDb.OpenRecordset(" SELECT * FROM " & RSAllName)
    With RSAll
      If .RecordCount > 0 Then ' first time through, Word (and probably Outlook too).
        ' You could probably also create your TempDB but I hven't done that here.
        Set wordApp = CreateObject("Word.Application")
        With wordApp
          .Visible = True
          ' Open your MMMDs once, at the beginning
          Set JuniorMMMD = .Documents.Open(JuniorMMMDFullName)
          Set AdultMMMD = .Documents.Open(AdultMMMDFullName)
        End With
      End If
      .MoveFirst ' probably not needed
      Do Until .EOF
        CurrentDb.Execute _
          " DELETE FROM " & RSOneName
        ' Insert into our temp database - helps solve locking problems
        ' You *could* insert the record directly into the temp db, using the following IN clause before the SELECT clause, and removing the TransferDatabase
        ' statement, but to do that, the table already has to exist with the correct structure, which we can avoid because TransferDatabase
        ' creates the structure. An Access person would probably know what's quickest if that's a concern.
        '
        CurrentDb.Execute " INSERT INTO " & RSOneName & _
          " SELECT * FROM " & RSAllName & _
          " WHERE ID = " & !ID
          
       ' That IN clause:
       ' " IN """ & TempDBFullName & """" & _
    
        DoCmd.TransferDatabase transfertype:=acExport, databasetype:="Microsoft Access", databasename:=TempDBFullName, objecttype:=acTable, Source:=RSOneName, Destination:=RSOneName
        
        If ![Membership Category] = "Junior Player" Or ![Membership Category] = "Junior Player (Sibling)" Then
          Call MergeOne(JuniorMMMD)
        Else
          Call MergeOne(AdultMMMD)
        End If
        .MoveNext
      Loop
      .Close
    End With
    
    problem: ' and final processing
    Debug.Print Err.Description, Erl
    If Not (wordApp Is Nothing) Then
      wordApp.Quit savechanges:=0 ' wdDoNotSaveChanges
      Set wordApp = Nothing
    End If
    If Not (RSAll Is Nothing) Then
      For Each x In CurrentDb.Recordsets
        If x.Name = RSAllName Then
          RSAll.Close
        End If
      Next
      Set RSAll = Nothing
    End If
    
    End Sub
    
    Sub MergeOne(MMMD As Word.Document)
    With MMMD
      With .MailMerge
        .MainDocumentType = 0 ' wdFormLetters
        .Destination = 0 ' wdSendToNewDocument
        .OpenDataSource _
          Name:=TempDBFullName, _
          sqlstatement:="SELECT * FROM [" & RSOneName & "]"
        .Execute
        .MainDocumentType = -1 ' wdNotAMergeDocument
      End With
      'Kill MailMergePDF
      With .Application.ActiveDocument
        .SaveAs2 FileName:=MailMergePDF, FileFormat:=17 'wdFormatPDF
        .Close savechanges:=0 ' wdDoNotSaveChanges
      End With
    End With
    End Sub