Question

我想从Excel宏运行mailmerge

宏的目标是

打开mailmerge模板（这可行）
链接Excel数据文件。（这有效）
依次为每条记录运行mailmerge，并使用其中一个数据字段保存每个结果文件（这仅适用于目前为止的第一条记录）。
在每个文档上，搜索并替换单词，例如green_并用绿色子弹替换它（搜索和替换工作，创建子弹但不使其成为颜色）。这是使用Word Macro的改编代码，它可以正常工作。

代码在这里：

Sub runmergeforWeeklyHR()
' 1) Merges active record and saves the resulting document named by the project id
' 2) Closes the resulting document, and continue to merge next record.
' 3) Replaces Rag Status Text with coloured bullets
' 4)Advances to the next record in the datasource
'


    Dim xls As Excel.Application
    Dim WorkingDirectory As String
    Dim TemporaryStor As String
    Dim ReportPeriod  As String
    Dim ProjRef As String
    Dim WordTemplate As String
    Dim ExcelDataFile As String
    Dim HRFilename As String


    WorkingDirectory = "U:\weekly HR\"
    TemporaryStor = WorkingDirectory + "TempFolderforWeeklyReps"
    WordTemplate = WorkingDirectory + "Weekly Highlight Report template.docm"
    ExcelDataFile = WorkingDirectory + "PMO Project Reporting spreadsheet - for mailmerge.xls"

    Set xls = New Excel.Application

'This opens a new instance of Word and opens a document
'To change what document is opened, edit the WordTemplate
DisplayAlerts = none
Dim objWord As Object
Set objWord = Nothing


Set objWord = CreateObject("Word.Application")


objWord.Visible = True

Dim wordtmpl As Document
Set wordtmpl = Nothing
Set wordtmpl = objWord.Documents.Open(WordTemplate)

' link document to data source
wordtmpl.MailMerge.MainDocumentType = wdFormLetters
wordtmpl.MailMerge.OpenDataSource Name:=ExcelDataFile, _
SQLStatement:="SELECT * FROM `Work Data$`"


'perform mail merge
      With ActiveDocument.MailMerge
          .Destination = wdSendToNewDocument
          .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
            .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
            ReportPeriod = .DataFields("Weekly_Reporting_Period").Value
            ProjRef = .DataFields("Work_ID_").Value

            'Select data for report file names.
            HRFilename = ProjRef + "_Weekly_Highlight_Report"
        End With
            ' Merge the active record
            .Execute Pause:=False

 'Update Rag Status with coloured bullet
    objWord.Application.Selection.Find.ClearFormatting
    objWord.Application.Selection.Find.Replacement.ClearFormatting
    With objWord.Application.Selection.Find.Replacement.Font.Color = 5287936
    With objWord.Application.Selection.Find
        .Text = "green_"
        .Replacement.Text = ChrW(9679)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        End With
      objWord.Application.Selection.Find.Execute Replace:=wdReplaceAll
    End With

    objWord.Application.Selection.Find.ClearFormatting
    objWord.Application.Selection.Find.Replacement.ClearFormatting
    With objWord.Application.Selection.Find.Replacement.Font.Color = 49407
        With objWord.Application.Selection.Find
        .Text = "amber_"
        .Replacement.Text = ChrW(9679)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        End With
     objWord.Application.Selection.Find.Execute Replace:=wdReplaceAll

    End With

    objWord.Application.Selection.Find.ClearFormatting
    objWord.Application.Selection.Find.Replacement.ClearFormatting
    With objWord.Application.Selection.Find.Replacement.Font.Color = wdColorRed
         With objWord.Application.Selection.Find
        .Text = "red_"
        .Replacement.Text = ChrW(9679)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        End With
      objWord.Application.Selection.Find.Execute Replace:=wdReplaceAll
    End With


    ' Save the resulting document.
            ActiveDocument.SaveAs2 Filename:=TemporaryStor + "\" + HRFilename, FileFormat:= _
                wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
                :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
                :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
            SaveAsAOCELetter:=False, CompatibilityMode:=14
     End With
    ' Now, back in the template document, advance to next record
 '   WordTemplate.MailMerge.DataSource.ActiveRecord = wdNextRecord
End Sub

任何人都可以帮忙。我已经搜索过了，但我找不到任何东西可以解决我的问题。

Answer 1

我没有时间对此进行测试，但我认为问题在于您完成With语句的方式。尝试将所有内容放在相同的块中，如下所示：

     With objWord.Application.Selection.Find
     .ClearFormatting
     .Replacement.ClearFormatting
    .Replacement.Font.Color = wdColorRed
    .Text = "red_"
    .Replacement.Text = ChrW(9679)
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
    End With

编辑**

这将循环记录。同样，我没有时间修改它以使其完全符合您的要求，但它会指向您正确的轨道。 Dim mergedDoc As Word.Document Dim numrecords As Integer

numrecords = 'count the numbr of records using excel sheet.
For i = 1 to numrecords
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = i
            .LastRecord = i
            ReportPeriod = .DataFields("Weekly_Reporting_Period").Value
            ProjRef = .DataFields("Work_ID_").Value

        'Select data for report file names.
        HRFilename = ProjRef + "_Weekly_Highlight_Report"
    End With
        ' Merge the active record
        .Execute Pause:=False
 Set MergedDoc = ObjWord.ActiveDocument 'You need to get the document you just made if you want to save it.
'You want to do all of your formatting to the created merged doc, so change all of your color changing code to the mergeddoc and then save....
Next i

Word和Excel Mailmerge - 从Excel运行 - 包括搜索和替换文本颜色的更改但不起作用

1 个答案: