邮件合并不正常

时间:2018-03-25 15:57:23

标签: vba ms-word

我有正确运行的Word VBA代码:

Sub Macro2()

    Documents.Open Filename:="testing.docx", AddToRecentFiles:=False
    strSourceDoc = ActiveDocument.Path & "" & "fixedcharge.xls"
    ActiveDocument.MailMerge.OpenDataSource Name:=strSourceDoc,Format:=wdOpenFormatAuto, 
        Connection:= "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & _
            strSourceDoc & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";" & _
            "Jet OLEDB:System database="""";Je", _
        SQLStatement:="SELECT * FROM ''Sheet$1''", SQLStatement1:="", _
            SubType:=wdMergeSubTypeAccess

    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True

        With .DataSource
            .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
            .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
        End With

    .Execute Pause:=False
    End With

End Sub

我的问题是我的Excel工作表有多个记录。将Word文档保存到SOW1.docx时,只保存一条记录,而其他记录则不保存。

2 个答案:

答案 0 :(得分:0)

以下是我使用的全部代码:

Sub MacroTest()
Documents.Open FileName:=ActiveDocument.Path & "\" & "Labels.docx", AddToRecentFiles:=False
strSourceDoc = ActiveDocument.Path & "\" & "Addresses.xlsx"
ActiveDocument.MailMerge.OpenDataSource Name:= _
    strSourceDoc _
    , 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=" & strSourceDoc & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:E" _
    , SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
    wdMergeSubTypeAccess

With ActiveDocument.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True

    With .DataSource
        .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
        .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
    End With

.Execute Pause:=False
End With

ActiveDocument.SaveAs FileName:="AllTogether.docx", FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False
End Sub

Sub AllSectionsToSubDoc()

Dim currentSection  As Long
Dim sections        As Long
Dim doc             As Document

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set doc = ActiveDocument
sections = doc.sections.Count
For currentSection = sections - 1 To 1 Step -1
    doc.sections(currentSection).Range.Copy
    Documents.Add
    ActiveDocument.Range.Paste
    ActiveDocument.SaveAs (doc.Path & "\" & currentSection & ".doc")
    ActiveDocument.Close False
Next currentSection

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

enter image description here

答案 1 :(得分:0)

您的代码仅查看活动记录。您应该允许它查看所有记录:

// Current Format
ext.versions = ['supportLibrary': '27.1.0',
                'kotlin'        : '1.2.31',
                'dagger'        : '2.15',]

// Desired Format
ext.versions = ['supportLibrary': '27.1.0',
                'kotlin': '1.2.31',
                'dagger': '2.15',]

并且,如果合适,将其与过滤器(通过SQLStatement的附加参数)组合以将输出限制为符合条件的任何记录。