首页 > 解决方案 > 如何用Excel表格替换Word中的文本?

问题描述

我正在尝试使用带有 VBA 的 Word 模板发送电子邮件。在模板的中间,我添加了 << Table >> 作为文本。我想用 Excel 文件中的表格替换此文本。

我收到

运行时错误“13”

到那个时刻

.Replacement.Text = Sheet1.Range("A24:F" & lr).SpecialCells(xlCellTypeVisible)
Sub SendMail()

    Dim ol As Outlook.Application
    Dim olm As Outlook.MailItem

    Dim wd As Word.Application
    Dim doc As Word.Document

    Set ol = New Outlook.Application

    Set olm = ol.CreateItem(olMailItem)
    
    Set wd = New Word.Application
    wd.Visible = True
    Set doc = wd.Documents.Open("C:\Users\campoalv\Desktop\US-Dec.docx")

    lr = Sheet1.Range("A" & Application.Rows.Count).End(xlUp).Row

    With wd.Selection.Find
        .Text = "<<Table>>"
        .Replacement.Text = Sheet1.Range("A24:F" & lr).SpecialCells(xlCellTypeVisible)
        .Execute Replace:=wdReplaceAll
    End With
    
    doc.Content.Copy
    
    With olm
        .Display
        .To = ""
        .Subject = "Test"
    
        Set Editor = .GetInspector.WordEditor
        Editor.Content.Paste
        '.Send
    End With

    Set olm = Nothing
    Application.DisplayAlerts = False
    doc.Close SaveChanges:=False
    Set doc = Nothing
    wd.Quit
    Set wd = Nothing
    Application.DisplayAlerts = True
    
End Sub

标签: excelvbatextreplacems-word

解决方案


您可以将范围复制到它找到内容的 Word 文档中<<Table>>。像这样的东西...

Sub SendMail()
On Error GoTo Err_
    Dim Word      As Word.Application
    Dim Document  As Word.Document
    
    Set Word = New Word.Application
    Set Document = Word.Documents.Add("C:\Users\campoalv\Desktop\US-Dec.docx")
    
    With Document.Content
        If .Find.Execute("<<Table>>") Then
            Range("A24:F" & Range("A" & Rows.Count).End(xlUp).Row).Copy
            .Paste
        End If
    End With
    
    With New Outlook.Application
        With .CreateItem(olMailItem)
            .To = ""
            .Subject = "Test"
            
            With .GetInspector.WordEditor
                Document.Content.Copy
                .Content.Paste
            End With
            
            .Display
        End With
    End With
    
    Word.Quit 0
    
Exit_:
    Exit Sub
Err_:
    If Not Word Is Nothing Then
        If Not Word.Visible Then Word.Quit 0
    End If

    MsgBox Err.Number & ": " & Err.Description, vbCritical, "Error"
    Resume Exit_
End Sub

推荐阅读