Outlook 2010 VBA 将消息另存为 MSG 无法作为脚本使用 [英] Outlook 2010 VBA Save Message as MSG Will Not Work as Script

问题描述

我试图在 Outlook 规则中获取一个脚本，以便在收到来自某个用户/域的电子邮件时自动将其保存到文件服务器.

I am trying to get a script inside an Outlook rule to automatically save e-mail messages to a file server when they are received from a certain user/domain.

我在此站点上找到了以下 VBA 脚本，如果我手动运行它，它就可以工作，但在我的 Outlook 规则中说使用脚本时它不起作用.

I found the following VBA Script on this site and it works if I manually run it, but it will not work inside my Outlook rule that says to use a script.

Sub SaveMessageAsMsg()
  Dim oMail As Outlook.MailItem
  Dim objItem As Object
  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String
  Dim enviro As String

    enviro = CStr(Environ("USERPROFILE"))
   For Each objItem In ActiveExplorer.Selection
   If objItem.MessageClass = "IPM.Note" Then
    Set oMail = objItem

  sName = oMail.Subject
  ReplaceCharsForFileName sName, "-"

  dtDate = oMail.ReceivedTime
  sName = sName & ".msg"

    sPath = enviro & "\Desktop\Allied E-File\"
  Debug.Print sPath & sName
  oMail.SaveAs sPath & sName, olMSG

  End If
  Next

End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "'", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

推荐答案

但它在我的 Outlook 规则中不起作用，该规则说使用脚本

but it will not work inside my Outlook rule that says to use a script

参数必须是 MailItem 类型，子程序才能在 Outlook 的规则向导中使用

The argument must be type MailItem for the subroutine to be available in the Rules Wizard in Outlook to work

示例

Public Sub SaveMessageAsMsg(oMail As Outlook.MailItem)

     'Your code here

End Sub

编辑

在 Outlook 2010

Option Explicit
Sub SaveMessageAsMsg(Item As Outlook.MailItem)
    Dim objItem As Object
    Dim sPath As String
    Dim dtDate As Date
    Dim sName As String
    Dim Enviro As String

    Enviro = CStr(Environ("USERPROFILE"))

    sName = Item.Subject
    ReplaceCharsForFileName sName, "-"

    dtDate = Item.ReceivedTime
    sName = sName & ".msg"

    sPath = Enviro & "\Desktop\Allied E-File\"
        Debug.Print sPath & sName
    Item.SaveAs sPath & sName, olMsg
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "'", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

请参阅此处如何创建规则

这篇关于Outlook 2010 VBA 将消息另存为 MSG 无法作为脚本使用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！