Running Mail Merge from Excel on an Embedded .docx (Word) file

问题

Please help on figuring this out as I'm stuck at the last stage trying to properly define my variables in the following code.

I want to execute the following in sequence:

Click the button 'CommandButton1'
The Form called 'CR_MMFormTest', which is an embedded document, will then open (mergefields already completed with no datasource pointed at, at the moment)
VBA helps me create a replica of the Form, and use that for....
Calling the function DistrictMailMerge

The problem, I encountered, lies on 3, and 4.

The replica script does not work for an embedded document. It would say

Run-time Error '5174': Sorry, we couldn't find your file. Was it moved, renamed, or deleted?

I'm not able to use the function DistrictMailMerge to recognise that the function should work on the opened document

What I tried: I thought about creating the Document Open event for my embedded documents but it wouldn't work. The documents only open as a temp document and the scripts will not save. So I cannot just execute the DistrictMailMerge function during the open event without using Excel to do it instead.

I believe the issue lies on the nature of these opened documents. They don't really 'exist' in a way a normal Word document would. I wonder if anyone could help me out please.

This is the subroutine:

Private Sub CommandButton1_Click()

Sheets("Resource Bank").Select
ActiveSheet.Shapes("CR_MMFormTest").Select
Selection.Verb xlVerbOpen


Call DistrictMailMerge

End Sub

This is the function I intended for the opened document to call:

Function DistrictMailMerge()
Application.ScreenUpdating = False
On Error GoTo NoKTOAccess

Application.Documents.Add ActiveDocument.FullName
Close_All_Except_Active_Document

RunMMKTO
Exit Function

NoKTOAccess:
    If Err.Number = 5174 Then
        RunMMPEO
    End If

Application.ScreenUpdating = True
End Function


Sub Close_All_Except_Active_Document()
    Dim i As Integer
    Dim KeepOpen As String
    KeepOpen = ActiveDocument.Name

    For i = Documents.Count To 1 Step -1
      If Documents(i).Name <> KeepOpen Then Documents(i).Close Savechanges:=wdDoNotSaveChanges
    Next i
End Sub


Sub RunMMKTO()
With ActiveDocument.MailMerge
.OpenDataSource _
    Name:="\\Astc-ls-001\new_admin\File Sharing\001. KLN 1\Caseworkers\Herman\Masterlist One-Stop Portal.xlsm", _
    Format:=wdOpenFormatAuto, _
    Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=\\Astc-ls-001\new_admin\File Sharing\001. KLN 1\Caseworkers\Herman\Masterlist One-Stop Portal.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry ", _
    SQLStatement:="SELECT * FROM [CR Step 2 - Mail Merge List$] WHERE [ISS No#] LIKE '%-%'", _
    SQLStatement1:="", SubType:=wdMergeSubTypeAccess
.ViewMailMergeFieldCodes = wdToggle
End With
End Sub


Sub RunMMPEO()
With ActiveDocument.MailMerge
.OpenDataSource _
    Name:="\\192.168.9.190\new_admin\File Sharing\Caseworkers\Herman\ISS OSP\Masterlist One-Stop Portal.xlsm", _
    Format:=wdOpenFormatAuto, _
    Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=\\Astc-ls-001\new_admin\File Sharing\001. KLN 1\Caseworkers\Herman\Masterlist One-Stop Portal.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry ", _
    SQLStatement:="SELECT * FROM [CR Step 2 - Mail Merge List$] WHERE [ISS No#] LIKE '%-%'", _
    SQLStatement1:="", SubType:=wdMergeSubTypeAccess
.ViewMailMergeFieldCodes = wdToggle
End With
End Sub

来源：https://stackoverflow.com/questions/45207127/running-mail-merge-from-excel-on-an-embedded-docx-word-file

标签

excel

excel-vba

ms-word

mailmerge

vba