Outlook 2010 VBA 将邮件另存为 MSG 将无法作为脚本使用

Outlook 2010 VBA Save Message as MSG Will Not Work as Script

我正在尝试在 Outlook 规则中获取一个脚本,以便在从某个 user/domain 收到电子邮件时自动将其保存到文件服务器。

我在该网站上找到了以下 VBA 脚本,如果我手动 运行 它可以工作,但它在我的 Outlook 规则中不起作用,该规则要求使用脚本。

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

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

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

例子

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

看这里how to create rule