Search code examples
vbaexcelms-wordmailmerge

Excel Workbook to Create Word Document and Auto-Run Mail Merge from Excel Workbook

I've got a bit of a tricky one here. Attempting to simplify an existing process.

Existing Process:

Word Document ("Plan Doc Template") is entirely composed of INCLUDETEXT fields that pull Bookmarked sections from another Word Document ("Source Plan Doc" we'll call it) that includes merge-fields in its bookmarked sections which are from an Excel Workbook ("Mail Merge Workbook").

The current process involves the user copying a Plan Doc Template and a Mail Merge Workbook and pasting it into any folder they choose. The user then fills out the Mail Merge Workbook, saves and closes, and runs a Mail Merge through the Plan Doc Template Word Doc. This pulls in bookmarked sections from the Source Plan Doc depending on the Mail Merge Workbook fields selected. The user then removes all INCLUDETEXT fields with CTRL + SHIFT + F9 to turn fields of Plan Doc Template into workable text.

(Hopeful) Future Process:

  1. The user copies a Mail Merge Workbook and pastes it into their desired folder. Fills out the Mail Merge Workbook. (Manual Step)
  2. Runs VBA Code.
  3. VBA copies the Plan Doc Template and pastes in the Mail Merge Workbook's folder that just ran the VBA code.
  4. VBA renames the Plan Doc Template Word Doc based on fields within the Mail Merge Workbook.
  5. VBA runs a Mail Merge within the Plan Doc Template
  6. VBA highlights entire document and CTRL + SHIFT + F9 to turn Field Codes into workable text.

Is it possible to do all this from an Excel VBA code or would I need a separate code after the Plan Doc has been created to run the mail merge and do the CTRL + SHIFT + F9 steps?

P.S. I use Excel Worksheets via DDE Selection to get the correct formatting from Mail Merge Workbook to Document. Hoping that can be included in the VBA code, as well.

Help would be greatly appreciated on this one, thanks,

Rich

Solution

  • May not be the most elegant code but here was what I wound up using to solve my question in case it helps anyone else. 

    Sub ButtonMerge()
Dim str1 As String
Dim PlanDocTemplate As String
Dim EDrive As String
Dim answer1 As Integer
Dim answer2 As Integer

answer1 = MsgBox("Is this IC Plan Workbook saved in the appropriate Client folder?", vbYesNo + vbQuestion)

If answer1 = vbNo Then
    MsgBox ("Please save this IC Plan Workbook in the appropriate Client folder then run again.")
    Exit Sub
Else
    'do nothing
End If

str1 = "Q:\IC\New Structure\IC Toolkit\Templates\01 Plan Doc Template\16 Source\IC Plan Doc Template v1.0.docx"
PlanDocTemplate = Application.ActiveWorkbook.Path & "\" & Range("A1").Value & ".docx"
EDrive = "E:\" & Range("A1").Value & ".docx"

If Len(Dir(Application.ActiveWorkbook.Path & "\" & Range("A1").Value & ".docx")) = 0 Then
    Call FileCopy(str1, PlanDocTemplate)
Else
    MsgBox ("The Plan document already exists, please delete or rename the existing Plan Doc in folder " _
    & Application.ActiveWorkbook.Path & "\ before creating a new one.")
    Exit Sub
End If

strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Worksheets("Data").Activate

'Opens New Plan Doc Template
Set appWD = CreateObject("Word.Application")
appWD.Visible = True

appWD.Documents.Open Filename:=PlanDocTemplate

ActiveDocument.MailMerge.OpenDataSource Name:=strWorkbookName, _
Format:=wdMergeInfoFromExcelDDE, _
ConfirmConversions:=True, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
Revert:=False, _
Connection:="Entire Spreadsheet", _
SQLStatement:="SELECT * FROM `Data$`", _
SQLStatement1:="", _
SubType:=wdMergeSubTypeOther

appWD.Visible = True

appWD.Selection.WholeStory
appWD.Selection.Fields.Update
appWD.Selection.Fields.Unlink
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
appWD.ActiveDocument.Save

Worksheets("Form").Activate
MsgBox "Successfully Created " & Range("A1").Value & " in Location: " & Application.ActiveWorkbook.Path & "\"

answer2 = MsgBox("Do you want to save a draft in the E:\ drive as well?", vbYesNo + vbQuestion, "E: Drive Copy")

If answer2 = vbYes Then
    If Dir("E:\") <> "" Then
        ActiveDocument.SaveAs2 Filename:= _
        "E:\" & Range("A1").Value & ".docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
        MsgBox ("Successfully Created " & Range("A1").Value & " in E:\ Location.")
        Exit Sub
    Else
        MsgBox ("Please open the E:\ drive and enter your username/password." & _
        vbCrLf & vbCrLf & "Click Ok when E:\ drive is opened.")
        If Len(Dir("E:\")) = 0 Then
            MsgBox ("Error connecting to E:\ drive." & vbCrLf & vbCrLf & "Please ensure you're connected and try again.")
            Exit Sub
        Else
            ActiveDocument.SaveAs2 Filename:= _
            "E:\" & Range("A1").Value & ".docx", _
            FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
            AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
            MsgBox ("Successfully Created " & Range("A1").Value & " in E:\ Location.")
            Exit Sub
        End If
    End If
Else
    Exit Sub
End If

End Sub