Joseph Michael Pesch
VP Programming

Microsoft Word VBA Macro to Run Mail Merge on SQL DSN

by 8. March 2012 13:07

This is a sample macro to generate a dynamic SQL connection and SQL select statement using VBA in Microsoft Word.  The only item I was not able to resolve is getting the connection string to be DSN-less (i.e. it seems to always require and actual ODBC DSN).

Private Sub Document_Open()
  Dim msg As String
  msg = "Select ""Yes"" to run the standard half month interval query." & _
        vbCrLf & vbCrLf & _
        "For a custom query select ""No"" " & _
        "and go to Mailings > Edit Recipient List > Filter"
  RunQuery (MsgBox(msg, vbYesNo, "Run Standard Query") = vbYes)
End Sub

Private Function GetConnection() As String
  GetConnection = "DSN=DWSQL;" & _
       "Driver={SQL Server};" & _
       "Server=servername\instancename,portnumber;" & _
       "Database=databasename;" & _
       "Trusted_Connection=yes;" & _
       "UID=" & Environ("username") & ";" & _
       "WSID=" & Environ("computername")

End Function

Private Sub RunQuery(Standard As Boolean)
  Dim doc As Document
  Set doc = ActiveDocument

  Dim sql As String
  If Standard Then
    sql = "select * from TestMailView where StandardCriteria = 'Y'"
    sql = "select * from TestMailView"
  End If

  ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
  ActiveDocument.MailMerge.OpenDataSource Name:="", ConfirmConversions:=False, _
    ReadOnly:=False, LinkToSource:=False, AddToRecentFiles:=False, _
    PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
    WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
    Connection:=GetConnection() _
    , SQLStatement:=sql, _
     SQLStatement1:="", SubType:=wdMergeSubTypeOther
  If Standard Then
    On Error GoTo MergeError
    With ActiveDocument.MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
      End With
      .Execute Pause:=False
    End With
    'Close the main doc since we already generated the merged doc.
    doc.Close (False)
  End If
     If Err.Number <> 0 Then MsgBox Err.Description
End Sub


Comments are closed