在outlook电子邮件正文中替换/添加文本

时间:2014-11-26 08:57:43

标签: outlook outlook-vba

我有一个带有或多或少结构化格式的电子邮件的文件夹。 在这些邮件中,例如有一行:成本:1234 我想要有一些自动编辑此文件夹中所有邮件的方式并添加AMT_金额。 所以邮件的正文需要更新到(例如上面的例子)费用:AMT_1234。

谁可以帮助我

1 个答案:

答案 0 :(得分:1)

处理文件夹

中的项目
Sub processFolder

    Dim oFolder As folder
    Dim oItem As object
    Dim oMail As mailItem

    Set olFolder = Session.PickFolder

    For Each oItem In olFolder.Items

        If oItem.class = olMail then

            'do stuff here

        End If
    Next

End Sub

将“费用:”替换为“费用:AMT_”

body = Replace(body,"Cost: ","Cost: AMT_")

如果不那么简单,则在此处描述从MessageBody解析文本。 http://msdn.microsoft.com/en-us/library/office/dd492012%28v=office.12%29.aspx#Outlook2007ProgrammingCh17_ParsingTextFromAMessageBody

Sub FwdSelToAddr()
    Dim objOL As Outlook.Application
    Dim objItem As Object
    Dim objFwd As Outlook.MailItem
    Dim strAddr As String
    On Error Resume Next
    Set objOL = Application
    Set objItem = objOL.ActiveExplorer.Selection(1)
    If Not objItem Is Nothing Then
        strAddr = ParseTextLinePair(objItem.Body, "Email:")
        If strAddr <> "" Then
            Set objFwd = objItem.Forward
            objFwd.To = strAddr
            objFwd.Display
        Else
            MsgBox "Could not extract address from message."
        End If
    End If
    Set objOL = Nothing
    Set objItem = Nothing
    Set objFwd = Nothing
End Sub

Function ParseTextLinePair _
  (strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocLabel, _
                            intLocCRLF - intLocLabel)
        Else
            intLocLabel = _
              Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If
    ParseTextLinePair = Trim(strText)
End Function

如果您在将所有内容放在一起时遇到问题,可以创建一个包含代码的新问题。