替换/添加Outlook电子邮件正文中的文本

Question

我有一个文件夹，里面有或多或少结构化格式的电子邮件项目。例如，在这些邮件中，有一行： 费用：1234我想有一些自动的方式来编辑此文件夹中的所有这些邮件并增加AMT_数量。因此，邮件的正文需要更新为（对于上面的示例）成本：AMT_1234。

谁可以帮助我解决这个问题

Answer 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_")

如果不是那么简单，那么这里描述了从消息正文解析文本。 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

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