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

我有一个文件夹，里面有或多或少结构化格式的emailitems。 例如，在这些邮件中有一行：Cost:1234 我想有一些自动化的方式来编辑这个文件夹中的所有邮件并添加金额。 因此邮件正文需要更新为（例如上面的例子）成本：AMT_1234

---

谁能帮我处理文件夹中的项目

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

将“成本：”替换为“成本：金额”

如果不是那么简单，那么这里将描述从MessageBody解析文本

Sub-FwdSelToAddr（）
将objOL设置为Outlook.Application
作为对象的Dim objItem
Dim objFwd作为Outlook.MailItem
像绳子一样变暗
出错时继续下一步
Set objOL=应用程序
设置objItem=objOL.ActiveExplorer.Selection（1）
如果不是，那么objItem什么都不是
strAddr=ParseTextLinePair（objItem.Body，“电子邮件：”）
如果是“”，那么
设置objFwd=objItem.Forward
objFwd.To=strAddr
objFwd.显示器
其他的
MsgBox“无法从邮件中提取地址。”
如果结束
如果结束
Set objOL=无
设置objItem=Nothing
设置objFwd=Nothing
端接头
函数ParseTextLinePair_
（strSource作为字符串，strLabel作为字符串）
Dim intLocLabel为整数
Dim intLocCRLF为整数
Dim intLenLabel为整数
将strText设置为字符串
intLocLabel=InStr（strSource，strLabel）
intLenLabel=Len（strLabel）
如果intLocLabel>0，则
intLocCRLF=InStr（intLocLabel、strSource、vbCrLf）
如果intLocCRLF>0，则
intLocLabel=intLocLabel+intLenLabel
strText=Mid（strSource_
intLocLabel_
intLocCRLF-intLocLabel）
其他的
intLocLabel=_
Mid（strSource、intLocLabel+intLenLabel）
如果结束
如果结束
ParseTextLinePair=修剪（strText）
端函数

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

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

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