自动化附件保存

时间:2012-10-24 10:25:37

标签: vba outlook outlook-vba

因此,目标是当我收到来自客户的电子邮件,其中包含所需的附件时,请将附件保存到我选择的位置。

这是我的新代码,它编译但不输出文件?

提前致谢。

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Application_NewMail()

Dim oInbox As MAPIFolder
Dim oItem As MailItem

Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oItem = oInbox.Items.GetLast

'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
    Set Msg = oItem

    'Change variables to match need. Comment or delete any part unnecessary.
    If (Msg.SenderName = "Name Of Person") And _
        (Msg.Subject = "Subject to Find") And _
        (Msg.Attachments.Count >= 1) Then

        'Set folder to save in.
        Dim olDestFldr As Outlook.MAPIFolder
        Dim myAttachments As Outlook.Attachments
        Dim Att As String

        'location to save in.  Can be root drive or mapped network drive.
        Const attPath As String = "C:\"

        ' save attachment
        Set myAttachments = item.Attachments
        Att = myAttachments.item(1).DisplayName
        myAttachments.item(1).SaveAsFile attPath & Att

        ' mark as read
       Msg.UnRead = False
    End If
End If

ProgramExit:
    Exit Sub

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

1 个答案:

答案 0 :(得分:1)

当您打开VBA窗口时,您将看到名为“ThisOutlookSession”的对象,您可以在此处放置代码。

收到新电子邮件时会自动触发此事件:

Private Sub Application_NewMail()

Dim oInbox As MAPIFolder
Dim oItem As MailItem


Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oItem = oInbox.Items.GetLast

//MsgBox oItem.To
//Etcetera 

End Sub

关于你的编辑,我没有真正调查它为什么不起作用,但你可以使用它,我测试过:

Dim atmt As Outlook.Attachment
Dim Att As String
Const attPath As String = "U:\"


For Each atmt In Msg.Attachments
    Att = atmt.DisplayName
    atmt.SaveAsFile attPath & Att
Next

请注意,您似乎没有保存文件,因为您无法在WinExplorer中使用“修改日期”来显示最新保存的附件(我刚才注意到)。但你可以按字母顺序查找它。