Converting Word>Excel mail merge to an Excel>Word merge

Question

Good morning,

I have an Excel document that is set up to complete a mail merge. Previously, a ran a script from within the MS Word mail merge template to call the Excel file, connect to it, and pull in the data. I recently found a code example that suggested embedding the code within the Excel document and pointing it to the Word template. This seems to make a lot more sense given my workflow.

This snippet worked within MS Word to reach out and connect to the Excel workbook:

ThisDocument.MailMerge.OpenDataSource Name:= _
    ThisDocument.Path & "\" & "REF 1.23.18.xlsm", ConfirmConversions:=False, _
    ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
    PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
    WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
    Connection:= _
    "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=reflist.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking " _
    , SQLStatement:="SELECT * FROM `REF_LTR$`", SQLStatement1:="", SubType:= _
    wdMergeSubTypeAccess

However, when I move the script over into MS Excel to try and connect to the Word template from Excel, this script is failing with a "run time error 4198 - Command Failed":

    wdocSource.MailMerge.OpenDataSource _
        Name:=strWorkbookName, _
        ConfirmConversions:=False, _
        AddToRecentFiles:=False, _
        Revert:=False, _
        Format:=wdOpenFormatAuto, _
        Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
        SQLStatement:="SELECT * FROM `REF_LTR$`", SQLStatement1:="", SubType:= _
    wdMergeSubTypeAccess

Any suggestions on what my second block of code is missing?

Here is the entire script for reference:

Sub test()

' Delete the first 8 rows which contain the header data
    On Error Resume Next
    Rows("1:8").Select
    Selection.Delete Shift:=xlUp

' Delete the empty spaces in column A, Name
    Columns("A:A").Select
    Selection.Replace What:="                    ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

' Delete the empty spaces in column B, MRN
    Columns("B:B").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

' Delete the empty spaces in columns D and E, format them as dates
    Columns("D:E").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "m/d/yyyy"

' Delete the empty spaces in columns F and G
    Columns("F:G").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

' Format AdmitTime as military time
    Columns("F:F").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "h:mm;@"
    Selection.NumberFormat = "hhmm"

' Delete any rows that don't have a name in column A
    Columns("A").SpecialCells(xlBlanks).EntireRow.Delete

' Add the column titles
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MRN"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Sex"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "DOB"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "AdmitDate"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "AdmitTime"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Category"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "ReferHospital"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Complaint"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Description"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Unit"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Disposition"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "LOS"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "ICD10"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "AdmitYear"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "AdmitMonth"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "AdmitDay"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "GenderPronoun"
    Range("A2").Select

' Add the helper columns to pull in the admityear, admitmonth, admitday, and genderpronoun
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-14]="""","""",TEXT(RC[-10],""yyyy""))"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-14]="""","""",TEXT(RC[-10],""yyyy""))"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-15]="""","""",TEXT(RC[-11],""mm""))"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-16]="""","""",TEXT(RC[-12],""dd""))"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-17]="""","""",IF(RC[-15]=""M"",""his"",""her""))"
    Range("O2:R2").Select
    Selection.Copy
    Range("O3:R50").Select
    ActiveSheet.Paste


' Find and replace hospital names
    Columns("H:H").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

' Fort Hamilton Hospital
    Columns("H:H").Select
        Cells.Replace What:="FortHamilton-HughesMemorialHospital(", Replacement _
        :="Fort Hamilton Hospital", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Grandview
    Columns("H:H").Select
        Cells.Replace What:="GrandviewHospital(OHMontgomery)", Replacement _
        :="Grandview Medical Center", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Greene Memorial Hospital
    Columns("H:H").Select
        Cells.Replace What:="GreeneMemorialHospital(OHGreene)", Replacement _
        :="Greene Memorial Hospital", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Kettering Health Network - Franklin
    Columns("H:H").Select
        Cells.Replace What:="FRANKLINSPRINGBOROED", Replacement _
        :="Kettering Health Network - Franklin", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Kettering Health Network - Huber
    Columns("H:H").Select
        Cells.Replace What:="HuberHeightsED", Replacement _
        :="Kettering Health Network - Huber", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Kettering Health Netowrk - Preble
    Columns("H:H").Select
        Cells.Replace What:="PrebleCoED", Replacement _
        :="Kettering Health Network - Preble", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' McCullough-Hyde Memorial Hospital
    Columns("H:H").Select
        Cells.Replace What:="McCullough-HydeMemorialHospital(OH", Replacement _
        :="McCullough-Hyde Memorial Hospital", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Mercer County Community Hospital
    Columns("H:H").Select
        Cells.Replace What:="MercerCountyJointTwp.CommunityHospi", Replacement _
        :="Mercer County Community Hospital", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Soin Medical Center
    Columns("H:H").Select
        Cells.Replace What:="SoinMedicalCenter", Replacement _
        :="Soin Medical Center", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Southview Medical Center
    Columns("H:H").Select
        Cells.Replace What:="SouthviewHospital&FamilyHealthCente", Replacement _
        :="Southview Medical Center", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Springfield Regional Medical Center
    Columns("H:H").Select
        Cells.Replace What:="CommunityHospitalofSpringfield(OHCl", Replacement _
        :="Springfield Regional Medical Center", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Columns("H:H").Select
        Cells.Replace What:="SpringfieldRegionalHosptial", Replacement _
        :="Springfield Regional Medical Center", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Sycamore Medical Center
    Columns("H:H").Select
        Cells.Replace What:="SycamoreHospital(OHMontgomery)", Replacement _
        :="Sycamore Medical Center", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Upper Valley Medical Center
    Columns("H:H").Select
        Cells.Replace What:="UpperValleyMedicalCenter", Replacement _
        :="Upper Valley Medical Center", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Wilson Memorial Hospital
    Columns("H:H").Select
        Cells.Replace What:="WilsonHospital(OHShelby)", Replacement _
        :="Wilson Memorial Hospital", LookAt:=xlPart, SearchOrder:=xlByRows _
        , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

' Select A1 cell
    Range("A1").Select

' This macro does the following:
' Runs a mail merge and pulls fields to create follow-up letter drafts
' Creates individual Word documents and then saves them in the appropriate folder for the hospital name
'
    Dim Name  As String
    Dim MRN  As String
    Dim Sex  As String
    Dim DOB  As String
    Dim AdmitDate  As String
    Dim AdmitTime  As String
    Dim Category  As String
    Dim ReferHospital  As String
    Dim Complaint  As String
    Dim Description  As String
    Dim Unit  As String
    Dim Disposition  As String
    Dim LOS  As String
    Dim ICD10  As String
    Dim AdmitYear  As String
    Dim AdmitMonth  As String
    Dim AdmitDay  As String
    Dim GenderPronoun  As String
    Dim wd As Object
    Dim wdocSource As Object
    Dim strWorkbookName As String

'Check to see if the folder exists, and if not, create it
    Dim fdObj As Object
    Set fdObj = CreateObject("Scripting.FileSystemObject")
    If fdObj.FolderExists(ThisDocument.Path & ReferHospital) Then
    Else
        fdObj.CreateFolder (ThisDocument.Path & ReferHospital)
    End If

' NEW!!!!
' Connect to the sign-in spreadsheet which is the data source
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open("C:\Users\k113997\Desktop\1macrotest\Trauma Referral Template.docm")

    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.CreateDataSource _
             Name:=strWorkbookName, _
             SQLStatement:="SELECT * FROM `REF_LTR$`", _
             SubType:=wdMergeSubTypeAccess


' Obtaines the number of records from the mail merge
    For i = 1 To ThisDocument.MailMerge.DataSource.RecordCount

' Counts the lines in the excel file
    With wdocSource.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i

' Ignore any records where Name is blank, as in empty data fields
    If Trim(.DataFields("Name")) = "" Then Exit For

' Pull in the datafields from the sign-in spreadsheet
        Name = .DataFields("Name").Value
        MRN = .DataFields("MRN").Value
        Sex = .DataFields("Sex").Value
        DOB = .DataFields("DOB").Value
        AdmitDate = .DataFields("AdmitDate").Value
        AdmitTime = .DataFields("AdmitTime").Value
        Category = .DataFields("Category").Value
        ReferHospital = .DataFields("ReferHospital").Value
        Complaint = .DataFields("Complaint").Value
        Description = .DataFields("Description").Value
        Unit = .DataFields("Unit").Value
        Disposition = .DataFields("Disposition").Value
        LOS = .DataFields("LOS").Value
        ICD10 = .DataFields("ICD10").Value
        AdmitYear = .DataFields("AdmitYear").Value
        AdmitMonth = .DataFields("AdmitMonth").Value
        AdmitDay = .DataFields("AdmitDay").Value
        GenderPronoun = .DataFields("GenderPronoun").Value
        End With

' Execute the mail merge
    .Execute Pause:=False
    End With


' Set the directory path for the output files to be the same as the directory for this document
docpath = ThisDocument.Path & "\" & ReferHospital

' Set the document naming convention with the course year, course month, course day, department, and course name
docname = AdmitYear + "-" + AdmitMonth + "-" + AdmitDay + " " + MRN

' Check and make sure that docname does not have any special characters that will mess up the filename, and if found, remove them
docnameclean = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(docname, "<", ""), ">", ""), ":", ""), "/", ""), "\", ""), "?", ""), "&", ""), "*", ""), ",", ""), ".", "")

' Change the focus to the active directory where the files are stored
    ChDrive ActiveDocument.Path
'    ChangeFileOpenDirectory _
'        ".\"

    ActiveDocument.SaveAs2 Filename:=docpath & "\" & docnameclean + ".docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

' Close the active document
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

' Switch to the next document in the mail merge
Next i

    wd.Visible = True
    wdocSource.Close SaveChanges:=False

    Set wdocSource = Nothing
    Set wd = Nothing


End Sub

Thanks, Chris

What's the text of the error? Please show us how you declare and instantiate wdocSource. Why have you dropped parameters from the original code? Why have you changed the Connection string? — Cindy Meister
Thanks for replying Cindy. I've edited the original post to show the entire code. The text of the error is "Command Failed". I am not strong with code editing, I am trying to adapt a sample I found online to fit my application. Any suggestions you can provide are appreciated! — ChrisV
Mmm... too much, now :-) Please take the time to trim this down to the minimal code it takes to reproduce the problem, with a full description of how to set things up, so that we can test efficiently. And also include which line of code is causing the error. Glancing through I can see a number of potential problems... We're happy to help, but our time isn't unlimited :-) — Cindy Meister
My apologies - I am not a scripting expert, I am mostly taking existing script and trying to revise it to meet our requirements. The line of script that is causing the issue is this one - "wdocSource.MailMerge.CreateDataSource". It is producing a "Run-time error '448': Named argument not found" error. — ChrisV

Kostas K. Kostas K. · Accepted Answer · 2018-02-08T07:33:30

When you open a Word document or attach a Template through VBA, the mail merge data source (if any) is not attached to the document for security reasons.

Try replacing:

wdocSource.MailMerge.OpenDataSource(...)

To:

wdocSource.MailMerge.CreateDataSource(...)

using the same method parameters but do not set the Connection parameter as it will be created for you.

wdocSource.MailMerge.CreateDataSource _
                     Name:=strWorkbookName, _
                     SQLStatement:="SELECT * FROM `REF_LTR$`", _ 
                     SubType:= wdMergeSubTypeAccess

Converting Word>Excel mail merge to an Excel>Word merge

1 Answers