通过替换 VBA 中的文本来编辑 Outlook 本地保存的 .msg 正文

Question

下午好，

我在计算机的本地文件夹中保存了一封 Outlook .msg 电子邮件。

有什么方法可以用 VBA 中我想要的任何单词替换正文中的单词“AAAA”？有什么办法可以更改收件人：字段吗？

目标是运行 Excel table 并创建模板消息的副本，将 To: 字段和模板的一些单词替换为 Excel table 并保存。后面我们会手动发送。

我只需要.msg文件修改代码（To: field and body replaces）。循环已经编码。

非常感谢，

Answer 1

Outlook 对象模型不提供任何现成的 MSG 文件编辑功能。但是您可以使 Outlook 自动创建一个项目，对其进行编辑，然后将其另存为模板。

使用 Application.CreateItemFromTemplate method which creates a new Microsoft Outlook item from an Outlook template (.oft) and returns the new item. So, you can create a new item based on the template saved on the disk and then replace everything you need there. Then you could save it back as a template or send the item out. Read more about that in the How To: Create a new Outlook message based on a template 文章。

Answer 2

可以使用Application.Session.OpenSharedItem打开一个MSG文件，修改返回的MailItem对象（Subject/HTMLBody/Recipients），然后调用MAilItem.Save 更新 MSG 文件。

Answer 3

如果有人需要，这是我使用的代码。不要关注 for 循环，而是关注 msg 的加载、编辑和保存方式。

在此示例中，msg 文件中的一些词被替换为 excel table 中的值，以及 TO:（电子邮件收件人）。例如msg 文件中的单词 AA 已更改为 C7 单元格的值。

目的是用一些关键词（AA、BB、CC 等）创建一个消息作为模板，复制该模板，将这些词替换为 excel table 并保存新的 msg 文件。

Sub Recorrer()

    Dim x As Integer
    Dim fsObject As Object

    Dim outApp As Object 'Outlook.Application
    Dim outEmail As Object 'Outlook.MailItem
    Dim outRecipient As Object 'Outlook.Recipient

    On Error Resume Next
        Set outApp = GetObject(, "Outlook.Application")
        If outApp Is Nothing Then
            MsgBox "Outlook is not open"
            Exit Sub
        End If

    On Error GoTo 0

    Set fsObject = CreateObject("Scripting.FileSystemObject")


    ' Set numcols = number of cols to be replaced.
    NumCols = Range("C1", Range("C1").End(xlToRight)).Cells.Count
    ' Set numrows = number of rows of data.
    NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count

    ' Select cell a1.
    Range("A2").Select

    ' Establish "For" loop to loop "numrows" number of times.

    For x = 1 To NumRows

        fsObject.CopyFile ThisWorkbook.Path & "\" & Range("B" & x + 1) & ".msg", ThisWorkbook.Path & "\Correos\" & Range("B" & x + 1) & "_" & Range("C" & x + 1) & ".msg"

        Set outEmail = outApp.Session.OpenSharedItem(ThisWorkbook.Path & "\Correos\" & Range("B" & x + 1) & "_" & Range("C" & x + 1) & ".msg")

        outEmail.Recipients.Add Range("A" & x + 1)

        For Z = 1 To NumCols

            'MsgBox Cells(x + 1, Z + 2)
            outEmail.HTMLBody = Replace(outEmail.HTMLBody, Cells(1, Z + 2), Cells(x + 1, Z + 2))
        
        Next

    outEmail.Save

    ' Selects cell down 1 row from active cell.
    ActiveCell.Offset(1, 0).Select

    Next

End Sub

通过替换 VBA 中的文本来编辑 Outlook 本地保存的 .msg 正文

Edit Outlook locally saved .msg body by replacing text in VBA

excel

outlook

vba

msg

office-automation