自動化附件保存

因此，我的目標是，當我收到一封來自客戶的電子郵件，其中包含所需的附件時，請將附件保存到我選擇的位置。自動化附件保存

這是我的新代碼，它編譯但不輸出文件？

在此先感謝。

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

來源

2012-10-24 William

當我實際運行代碼時，我用我的顯示名稱替換參數，然後輸入'Test'，然後發送自己的電子郵件。 – William

當您打開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使用「修改日期」，以顯示最新保存的附件（我剛纔注意到）。但你可以按字母順序來查看。

來源

2012-10-24 12:24:40 Trace

感謝您的回答。從我上面的代碼中，我將Application_Startup（）更改爲Application_NewMail（）..這就是我需要做的嗎？我一直在玩它，無法讓它工作。 – William

不，Application_Startup只是啓動Outlook時執行的代碼。在你的示例代碼中，我讀了下面這行：Set Msg = item你可以做的就是設置Msg = oItem並將代碼從這裏複製粘貼到Application_NewMail中（在我發佈的示例之後）。 – Trace

請參閱我的編輯，我想我遵循了你的指示，我想我已經快到了。 – William

自動化附件保存

回答

相關問題