替换正文中的文本并保存答案

【问题标题】：Replace Text in body and save替换正文中的文本并保存
【发布时间】：2020-08-15 07:26:19
【问题描述】：

我收到包含链接的电子邮件。该链接不起作用，因为我不在该公司的网络上。我可以更改部分链接以供外部使用以使其正常工作。

例如电子邮件有这个链接：

https://ipdms.web.companyname.com/ipdms/itemlocation

我改成：

https://companyVPN.companyname.com/ipdms/itemlocation

我能够创建一个脚本，但我需要打开电子邮件，运行宏，然后点击电子邮件上的保存。

Sub Change2VPN()

Application.ActiveInspector.CurrentItem.body = _
  Replace(Application.ActiveInspector.CurrentItem.body, "ipdms.web", "companyVPN")

End Sub

我进行了搜索，但无法获得任何工作。有没有办法我可以在文件夹中的所有项目上完成此操作并将电子邮件保存在它所在的位置，或者至少从阅读窗格中完成？

我可以将宏按钮添加到功能区。
由于公司政策，我无法在收到的电子邮件上运行脚本作为规则。

【问题讨论】：

你搜索过什么吗？我在不到 5 秒的时间内找到了this。

标签： vba outlook office365

【解决方案1】：

基本上，您需要获取单击功能区按钮的当前选定文件夹并遍历文件夹中的所有项目以完成工作：

Sub Change2VPN()

Dim olFolder As Outlook.Folder
Dim Item As Object
Dim explorer as Outlook.Explorer


Set explorer = Application.ActiveExplorer()
Set olFolder = explorer.CurrentFolder

For Each Item In olFolder.Items
    If TypeOf Item Is Outlook.MailItem Then 
        Dim oMail As Outlook.MailItem: Set oMail = Item
        oMail.HTMLBody = Replace(oMail.HTMLBody, "ipdms.web", "companyVPN")
        oMail.Save()
    End If
Next

End Sub

【讨论】：