(MS Word / VBA)文档打开时执行邮件合并

时间:2017-07-20 04:01:48

标签: vba ms-word word-vba

我一直在尝试使用我的宏进行测试但不知何故有些东西无效。我尝试录制宏并将代码与我的代码进行比较。录制的宏工作。但是一旦我开始修改它,如果我运行宏,就什么都不会发生。

我有Word对象库

工作宏:

Sub DistrictMailMerge()
On Error GoTo NoKTOAccess

ActiveDocument.MailMerge.Destination = wdSendToNewDocument
RunMMKTO
Exit Sub

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



Sub RunMMKTO()
'Wrong Filename for testing purpose'
'-----------------------------------
    ActiveDocument.MailMerge.OpenDataSource _
    Name:="\\Astc-ls-001\new_admin\File Sharing\001. KLN 1\Caseworkers\Herman\Masterlist One-Stop Portal.xlsm2", _
    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=\\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
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
End Sub



Sub RunMMPEO()
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "\\192.168.9.190\new_admin\File Sharing\Caseworkers\Herman\ISS OSP\Masterlist One-Stop Portal.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=\\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
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
End Sub

不执行任何操作的宏(很少出现如下所示的错误):

  

运行时错误错误' 5852':请求的对象不可用

Sub DistrictMailMerge()
On Error GoTo NoKTOAccess

ActiveDocument.MailMerge.Destination = wdSendToNewDocument
RunMMKTO
Exit Sub

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


Sub RunMMKTO()
'Wrong Filename for testing purpose'
'-----------------------------------
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.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
.Execute
End With
End Sub



Sub RunMMPEO()
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.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
.Execute
End With
End Sub

1 个答案:

答案 0 :(得分:0)

有两种方法可以解决您的问题。

  1. 找出您的子DistricMailMerge实际上做了什么。在第一行放置一个断点并按F5。当它点击停止时继续按F8并观察它实际执行的部分。
  2. 我不熟悉MailMerge。因此,我从这里开始: - https://msdn.microsoft.com/en-us/vba/word-vba/articles/mailmerge-object-word。我发现你的代码与MS建议的完全不同。我对您的行ActiveDocument.MailMerge.Destination = wdSendToNewDocument很感兴趣,它似乎只指定将合并发送到文档而不指定哪一个,也不指定如何合并。 MS建议的代码解决了这个问题。 如果不进一步研究,我会发现为什么你的两个版本中的一个实际上比另一个版本的功能强大得多的问题。