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

Question

下午好，

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

有什么办法可以用我想要的VBA中任何一个单词替换体内“ AAAA”一词？ 有什么办法可以将其更改为：字段？

目的是运行一个Excel表并创建模板消息的副本，将其替换为：字段和模板的某些单词，并在Excel表中使用信息并保存。我们将手动发送后者。

我只需要.msg文件修改代码（到：字段和身体替换）。循环已经编码。

太感谢了，

Answer 1

Outlook Object模型没有提供任何包装盒中编辑MSG文件的任何内容。但是，您可以自动化Outlook创建项目，对其进行编辑，然后将其保存为模板。

使用”来自Outlook模板（.oft）的新的Microsoft Outlook项目，并返回新项目。因此，您可以根据保存在磁盘上的模板创建一个新项目，然后更换所需的所有内容。然后，您可以将其保存为模板或将项目发送出去。在如何：基于模板创建新的Outlook消息文章。

Answer 2

您可以使用application.session.session.opensharedItem打开MSG文件，修改返回的mailItem Object（主题/code>/htmlbody/收件人），然后调用mailItem.save以更新MSG文件。

Answer 3

如果有人需要，这是我使用的代码。不要专注于for循环，而要以加载，编辑和保存的味精的方式。

在此示例中，MSG文件中的某些单词被替换为Excel表中的值以及TO ：（电子邮件接收器）。例如，MSG文件中的单词AA随C7单元格的值而更改。

目的是将MSG创建为具有一些关键词（AA，BB，CC等）的模板，复制该模板，将这些单词替换为Excel表中的单词并保存新的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