Question

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

我在这个网站上找到了以下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

Answer 1

但它在使用脚本
的Outlook规则中不起作用

参数必须是 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

Outlook 2010 VBA将消息另存为MSG将无法用作脚本

1 个答案: