从Outlook VBA下载附件

时间:2019-10-16 13:02:34

标签: vba outlook outlook-vba

我在Outlook VBA ThisOutlookSession中具有此代码,它没有给出任何错误,但没有下载附件。任何想法

Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
   Set objInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
   Dim objMail As Outlook.MailItem
   Dim strSenderAddress As String
   Dim strSenderDomain As String
   Dim objAttachment As Attachment
   Dim strFolderPath As String
   Dim strFileName As String

   If Item.Class = olMail Then
      Set objMail = Item

      'Get sender domain
      strSenderAddress = objMail.SenderEmailAddress
      strSenderDomain = Right(strSenderAddress, Len(strSenderAddress) - InStr(strSenderAddress, "@"))

      'Change to the specific domain as per your needs
      If strSenderDomain = "gmail.com" Then
       If strSenderAddress = "vs@gmail.com" Then
         If objMail.Attachments.Count > 0 Then
            For Each objAttachment In objMail.Attachments
                strFolderPath = "E:\Cisco - Qutar\Performance Report Automation\"
                strFileName = objMail.Subject & " " & Chr(45) & " " & objAttachment.FileName
                objAttachment.SaveAsFile strFolderPath & strFileName
            Next
         End If
      End If
   End If
 End If
End Sub

立即更新

1 个答案:

答案 0 :(得分:0)

以下设置您的Application_Startup()

Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Set Items = Inbox.Items
End Sub