Attachment Download

vmjan02

Active Member
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
 

ZVI

MrExcel MVP
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:

vmjan02

Active Member
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]
 

ZVI

MrExcel MVP
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
 

ZVI

MrExcel MVP
When you are running Test, does it show Folder name where emails are expected to be?
 
Last edited:

DanteAmor

Well-known Member
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
 

vmjan02

Active Member
@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.
 

Some videos you may like

This Week's Hot Topics

Top