Private WithEvents myFolderItems As Outlook.Items

Private Sub Application_Startup()

? ? Set myFolderItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("AAA").Items

End Sub

Private Sub myFolderItems_ItemAdd(ByVal item As Object)

? ? On Error GoTo ErrorHandler

? ? Dim saveFolder As String

? ? Dim objMail As Outlook.MailItem

? ? Dim objAttach As Outlook.Attachment

? ? Dim i As Integer

? ??

? ? ' 選擇保存附件的文件夾路徑

? ? saveFolder = "C:\"

? ? ? ??

? ? If TypeOf item Is Outlook.MailItem Then

? ? ? ? Set objMail = item

? ? ? ??

? ? ? ? ' 為此電子郵件創(chuàng)建文件夾并更改FolderPath以查找此文件夾。

? ? ? ? FName = objMail.Subject

? ? ? ??

? ? ? ? ' 刪除非法字符

? ? ? ? For i = 1 To Len(FName)

? ? ? ? ? ? c = Mid(FName, i, 1)

? ? ? ? ? ? Select Case c

? ? ? ? ? ? ? ? Case Is = "/"

? ? ? ? ? ? ? ? ? ? Mid(FName, i) = "."

? ? ? ? ? ? ? ? Case Is = "\", "|", "?", "<", ">", ":", "*", """"

? ? ? ? ? ? ? ? ? ? Mid(FName, i) = ""

? ? ? ? ? ? End Select

? ? ? ? Next i

? ? ? ??

? ? ? ? If Len(Dir(saveFolder & "\" & FName, vbDirectory)) = 0 Then

? ? ? ? ? ? MkDir (saveFolder & "\" & FName)

? ? ? ? End If

? ? ? ??

? ? ? ? ' 循環(huán)遍歷所有附件

? ? ? ? For Each objAttach In objMail.Attachments

? ? ? ? ? ? ' 將附件另存為指定的文件夾下

? ? ? ? ? ? objAttach.SaveAsFile saveFolder & "\" & FName & "\" & objAttach.FileName

? ? ? ? Next objAttach

? ? End If

ProgramExit:

? ? Exit Sub

? ??

ErrorHandler:

? ? MsgBox Err.Number & " - " & Err.Description

? ? Resume ProgramExit

End Sub