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
我正在尝试在 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