Attachment Download

vmjan02

Well-known Member
Joined
Aug 15, 2012
Messages
1,047
Office Version
  1. 365
  2. 2021
  3. 2019
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.

Code:
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
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
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:
Rich (BB code):
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):
Rich (BB code):
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:
Rich (BB code):
  strFileName = objMail.Subject & " " & Chr(45) & " " & objAttachment.Filename
  Debug.Print strFileName ' <-- see if illegal symbols like [? "" / \ < > * | :] are in the Immediate window
 
Last edited:
Upvote 0
Hi Zvi,

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

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]
 
Upvote 0
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:
Rich (BB code):
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
 
Upvote 0
When you are running Test, does it show Folder name where emails are expected to be?
 
Last edited:
Upvote 0
Try this

Code:
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
 
Upvote 0
@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.
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,981
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top