代码之家 › 专栏 › 技术社区 › rakesh seebaruth

邮件合并多个记录

ms-word vba

rakesh seebaruth · 技术社区 · 8 年前

正确运行的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 回复 | 直到 5 年前

sunsetsurf 8 年前

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

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

macropod 8 年前

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

With .DataSource
    .FirstRecord = wdDefaultFirstRecord
    .LastRecord = wdDefaultLastRecord
End With

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