Word与Excel数据的邮件合并必须保存在具有基于单元格值的自定义名称的文件中

iszxjhcz  于 2023-01-03  发布在  其他
关注(0)|答案(1)|浏览(125)

我有一封用Word写的信和一个用Excel写的充满数据的工作表。
我需要在Word中使用工作表的数据进行邮件合并。
问题是每个邮件合并都必须保存为不同的Word文件,而且,每个文件都必须使用邮件合并中使用的数据的名称保存。
例如:
我的Excel有一个表,表中有3列,分别称为"姓名"、"姓氏"和"生日"。此表有10行。
我需要做的Word中的姓名,姓氏和生日邮件合并。
每个邮件合并都必须保存在不同的文件中(最后,我们将有10个文件,每行1个)。
每个文件都必须命名为从邮件合并中提取的相对姓氏。
我发现这个VBA代码在线,并尝试在Word中:

' Modulo1 - Modulo'

Option Explicit

Public Sub Test()

On Error GoTo ErrH

Dim mm As Word.MailMerge
Dim i

Application.ScreenUpdating = False

Set mm = ThisDocument.MailMerge
With mm
    .Destination = wdSendToNewDocument
    With .DataSource
        For i = 1 To .RecordCount
            .FirstRecord = i
            .LastRecord = i
            mm.Execute
            With Application.ActiveDocument
                .SaveAs "C:\Users\Alessandro\Desktop\excel udine\TRIESTE\" & Format(i, "0000") _
                  , wdFormatDocument _
                  , AddToRecentFiles:=False
                .Saved = True
                .Close
            End With
        Next
    End With
End With

ExitProc:
    Application.ScreenUpdating = True
    Set mm = Nothing
    Exit Sub

ErrH:
    MsgBox Err.Description
    Resume ExitProc

End Sub

这段代码保存了每一个邮件合并。问题是文件名是一个数字,如0001,0002等。
我需要将该名称设置为存储在Excel工作表中并在邮件合并中使用的值。

g9icjywg

g9icjywg1#

我设法找到了自己问题的解决方案。我仍然不知道为什么我不能让旧代码工作,但这段代码工作得很完美:

Public Sub Mail_Merge()

On Error GoTo ErrH

Dim mm As Word.MailMerge
Dim singleDoc As Document
Dim i
Dim nameFile As String
Dim path As String

path = "WRITE PATH TO SAVE FILE"
nameFile = "WRITE COLUMN NAME FROM MAIL MERGE"

Application.ScreenUpdating = False

Set mm = ThisDocument.MailMerge

mm.DataSource.ActiveRecord = wdFirstRecord

For i = 1 To mm.DataSource.RecordCount
    mm.Destination = wdSendToNewDocument

    mm.DataSource.FirstRecord = mm.DataSource.ActiveRecord
    mm.DataSource.LastRecord = mm.DataSource.ActiveRecord
    
    mm.Execute False

    Set singleDoc = ActiveDocument

    singleDoc.SaveAs2 _
        FileName:=path & mm.DataSource.DataFields(nameFile).Value, _
        FileFormat:=wdFormatDocumentDefault, _
        AddToRecentFiles:=False

    singleDoc.Close False

    mm.DataSource.ActiveRecord = wdNextRecord
Next

ExitProc:
    Application.ScreenUpdating = True
    Set mm = Nothing
    Exit Sub
   
ErrH:
    MsgBox Err.Description
    Resume ExitProc
   
End Sub

相关问题