Outlook自动保存附件到硬盘目录

打开outlook, 按ALT-F11,打开microsfot visual basid-vbaProject, 工具－preferences- 确保microsoft office Object library前面打了勾。

然后，插入－模块

Sub SaveToNwsFolder(MyMail As MailItem)
Dim strID As String
Dim objNS As Outlook.NameSpace
Dim objMail As Outlook.MailItem
Dim objAtt As Outlook.Attachment
Dim c As Integer
Dim save_name As String
'Place path to sav to on next line. Note that you must include the
'final backslash
Const save_path As String = "N:\settle\nws\"

strID = MyMail.EntryID
Set objNS = Application.GetNamespace("MAPI")
Set objMail = objNS.GetItemFromID(strID)

If objMail.Attachments.Count > 0 Then
For c = 1 To objMail.Attachments.Count
Set objAtt = objMail.Attachments(c)
save_name = Left(objAtt.FileName, Len(objAtt.FileName) - 4)
'save_name = save_name & Format(objMail.ReceivedTime, "_mm-dd-yyyy_hhmm")
save_name = save_name & Right(objAtt.FileName, 4)
objAtt.SaveAsFile save_path & save_name

Next
End If

Set objAtt = Nothing
Set objMail = Nothing
Set objNS = Nothing
End Sub

保存，注意要修改其中的目录名，目录要以反斜杠结尾。

然后，在outlook中创建 规则，在选择动作的时候， 选运行脚本，然后在弹出的对话框中选择刚才保存的工程模块即可。