Attachment Download

[vmjan02]

I have the below code and have it is on Outlook VBA on ThisOutlookSession

But I am still not able to download the attachments in the folder, I am trying this for quite a while now but no luck, did
google as well. It is not showing any error, but still not downloading the attachment in the folder

Help please.

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 = "vs@gmail.com" Then
         If objMail.Attachments.Count > 0 Then
            For Each objAttachment In objMail.Attachments


                strFolderPath = "E:\Performance Report\"
                strFileName = objMail.Subject & " " & Chr(45) & " " & objAttachment.FileName
                objAttachment.SaveAsFile strFolderPath & strFileName
            Next
         End If
      End If
   End If
End Sub

 

[DanteAmor]

Check the following code:

https://www.mrexcel.com/forum/gener...download-outlook-attachments-not-working.html

 

[ZVI]

I have the below code and have it is on Outlook VBA on ThisOutlookSession

The code of objInboxItems_ItemAdd is triggered in case emails are going to this folder:

Sub Test()
  With Session.GetDefaultFolder(olFolderInbox)
    MsgBox .Parent & "/" & .Name
  End With
End Sub

You may check the code is triggered by this testing version of the objInboxItems_ItemAdd code (send email to yourself):

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
  MsgBox "Ok"
End Sub

If Ok message appears then the problem can be in illegar for the file name symbols in a Subject.
Check it by printing strFileName to the Immediate window:

  strFileName = objMail.Subject & " " & Chr(45) & " " & objAttachment.Filename
  Debug.Print strFileName ' <-- see if illegal symbols like [? "" / \ < > * | :] are in the Immediate window

 

[vmjan02]

Hi Zvi,

msg "OK" not coming, below is the modified code.

Public WithEvents objInboxItems As Outlook.Items
Sub test()
With Session.GetDefaultFolder(olFolderInbox)
    MsgBox .Parent & "/" & .Name
  End With
End Sub
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 = "@flintmail.com" Then
       If strSenderAddress = "viral.shah@flintmail.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

[\code]

 

[ZVI]

Run manually the Test, it shows the Folder where emails are expected for the code.
Is this folder correct for your purpose?
Emails coming into other folders do not trigger the code

As to the testing code I meant this:

Public WithEvents objInboxItems As Outlook.Items

' Run this code manually for the testing or reload Outlook
Private Sub Application_Startup()
   Set objInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
  MsgBox "Ok"
End Sub

 

[vmjan02]

No, its not working. msg not coming,

 

[ZVI]

When you are running Test, does it show Folder name where emails are expected to be?

 

[vmjan02]

When you are running Test, does it show Folder name where emails are expected to be?

no

 

[DanteAmor]

Try this

Code:

Sub download_attachments()
    Dim olApp As Outlook.Application
    Dim olmail As MailItem
    Dim Att As Object
    Dim olFolder As Outlook.Folder
    Dim namap As Namespace
    Dim subfolder As Outlook.Folder
    
    strfolderpath = "U:\test_folder\"


    Set olApp = CreateObject("Outlook.application")
    Set olmail = olApp.CreateItem(olMailItem)
    Set olFolder = olApp.GetNamespace("MAPI").PickFolder
    
    For Each subfolder In olFolder.Folders
        On Error Resume Next
        For Each olmail In subfolder.Items
            If TypeName(olmail) = "MailItem" Then
                y = 1
                For Each Att In olmail.Attachments
                    strfile = olmail.Attachments.Item(y).Filename
                    strfile = strfolderpath & strfile
                    olmail.Attachments.Item(y).SaveAsFile strfile
                    y = y + 1
                Next Att
            'Else
            '    Exit Sub
            End If
        Next
    Next
    MsgBox "Done"
End Sub

 

[vmjan02]

@DanteAmor

Tried this code as well, but its just giving me msg done. nothing else. As it should check the inbox and then should download the attachments.