Executing a Mail Merge with An Embedded Word File

[GazB]

Hi All,

I'm having some trouble performing a mail merge using an embedded Word file. Essentially I'm trying to build a macro to:

• Open an embedded Word file (let's say the file is Object(2))
• Connect the Export sheet to the word fie
• Preview the results
• Update the table of contents
• Export the file as a PDF
• Close the word application leaving the completed PDF open

Here's the code I have so far but it doesn't work. Could anyone help me with where I'm going wrong? It opens the embedded word object in MS Word 2007 and also opens a MS Word 97 application but that's it!

Public Sub fExportSVF()

    Dim objWd As Object
    Dim appWd As Word.Application
    Dim WdDoc As Word.Document
    Dim strWbName As String
    Dim strPeril As String
    Dim strClaimNumber As String
    Dim strPHName As String
    Dim strSaveLoc As String
    
    strPeril = Worksheets("Settings").Range("B3").Value
    strClaimNumber = Worksheets("Settings").Range("B1").Value
    strPHName = Worksheets("Settings").Range("B2").Value
    
    strSaveLoc = ActiveWorkbook.Path & "\" & strClaimNumber & _
    " - " & strPHName & " - " & strPeril & ".pdf"

    Call fUnhideSheet("EXPORT_DATA")
    
    On Error Resume Next
    
    If strPeril = "Accidental Damage" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(2)
        
    ElseIf strPeril = "Accidental Loss" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(3)
        
    ElseIf strPeril = "AD To Drains" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(4)
        
    ElseIf strPeril = "Escape of Water" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(5)
        
    ElseIf strPeril = "Fire" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(6)
        
    ElseIf strPeril = "Flood" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(7)
        
    ElseIf strPeril = "Impact" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(8)
        
    ElseIf strPeril = "Storm" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(9)
        
    ElseIf strPeril = "Theft" Then
    
        Set objWd = Worksheets("Settings").OLEObjects(10)
            
    End If
    
    objWd.Verb Verb:=xlPrimary

    Set appWd = CreateObject("Word.Application")

    appWd.DisplayAlerts = wdAlertsNone
    appWd.Visible = True

    Set WdDoc = appWd.Documents(1)

    strWbName = Worksheets("Settings").Range("B4").Value

    WdDoc.MailMerge.MainDocumentType = wdFormLetters
 
    WdDoc.MailMerge.OpenDataSource Name:= _
        strWbName _
        , 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=" & strWbName & _
        ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet " & _
        "OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine " _
        , SQLStatement:="SELECT * FROM `EXPORT_DATA$`", SQLStatement1:="", _
        SubType:=wdMergeSubTypeAccess
    WdDoc.MailMerge.ViewMailMergeFieldCodes = wdToggle

    WdDoc.TablesOfContents(1).Update

    WdDoc.ExportAsFixedFormat outputfilename:=strSaveLoc, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

    Call fHideSheet("EXPORT_DATA")
    
    Set WdDoc = Nothing
    Set appWd = Nothing
    Set objWd = Nothing
    

End Sub

Thanks
Gareth

[GazB]

Forgot to mention, I would prefer the operation to be invisible to the user (i.e. visibility of the word application non-existent!)

Thanks

[GazB]

Ok so I've got it to a point where it'll complete everything apart from destroying the WINWORD.exe process. Any ideas?

Sub test()

    Dim WdObj As Object
    Dim WdApp As Word.Application
    Dim WdDoc As Word.Document
    Dim intIndex As Integer
    Dim strPeril As String
    Dim strClaimNumber As String
    Dim strPHName As String
    Dim strSaveLoc As String
    Dim strWbName As String
    
    Application.ScreenUpdating = False
    
    Call fUnhideSheet("EXPORT_DATA")
    
    strWbName = Worksheets("Settings").Range("B4").Value
    strPeril = Worksheets("Settings").Range("B3").Value
    strClaimNumber = Worksheets("Settings").Range("B1").Value
    strPHName = Worksheets("Settings").Range("B2").Value
    
    strSaveLoc = ActiveWorkbook.Path & "\" & strClaimNumber & _
    " - " & strPHName & " - " & strPeril & ".pdf"
    
    Select Case strPeril
        Case "Accidental Damage"
            intIndex = 2
        Case "Accidental Loss"
            intIndex = 3
        Case "AD to Drains"
            intIndex = 4
        Case "Escape of Water"
            intIndex = 5
        Case "Fire"
            intIndex = 6
        Case "Flood"
            intIndex = 7
        Case "Impact"
            intIndex = 8
        Case "Storm"
            intIndex = 9
        Case "Theft"
            intIndex = 10
    End Select
    
    Set WdObj = Worksheets("Settings").OLEObjects(intIndex)
    
    WdObj.Activate
    WdObj.Object.Application.Visible = False
    
    Set WdApp = GetObject(, "Word.Application")
    Set WdDoc = WdApp.ActiveDocument
    
    WdApp.Visible = False
    
    WdDoc.MailMerge.MainDocumentType = wdFormLetters
        
    WdDoc.MailMerge.OpenDataSource Name:= _
        strWbName _
        , 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=" & strWbName & _
        ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet " & _
        "OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine " _
        , SQLStatement:="SELECT * FROM `EXPORT_DATA$`", SQLStatement1:="", _
        SubType:=wdMergeSubTypeAccess
    WdDoc.MailMerge.ViewMailMergeFieldCodes = wdToggle
    
    WdDoc.TablesOfContents(1).Update
    
    WdDoc.ExportAsFixedFormat outputfilename:=strSaveLoc, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
        
    WdApp.Quit
    
    Set WdApp = Nothing
    Set WdObj = Nothing
    
    Call fHideSheet("EXPORT_DATA")
    
    Application.ScreenUpdating = True
    
End Sub

[GazB]

Anyone have any cluses on this one. Still can;t get WINWORD.exe to close?

Cheers
Gareth