# Attachment Download



## vmjan02 (Oct 16, 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.


```
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 (Oct 16, 2019)

Check the following code:

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


----------



## ZVI (Oct 16, 2019)

vmjan02 said:


> 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 (Oct 17, 2019)

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 (Oct 17, 2019)

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 (Oct 18, 2019)

No, its not working. msg not coming,


----------



## ZVI (Oct 18, 2019)

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


----------



## vmjan02 (Oct 18, 2019)

ZVI said:


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


no


----------



## DanteAmor (Oct 18, 2019)

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 (Oct 18, 2019)

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


----------



## vmjan02 (Oct 16, 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.


```
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 (Oct 18, 2019)

Hi @vmjan02,

It is in the main inbox folder or it is in some subfolder.
The macro works for me and for the user who requested it on the link.

Remove this line from the macro and execute step by step and tell me what error message appears.

```
On Error Resume Next
```


Do you have outlook? what version?


If the files are in a subfolder check this:
https://www.mrexcel.com/forum/gener...097631-count-emails-outlook-export-excel.html


----------



## vmjan02 (Oct 18, 2019)

did removed the code "on Error Resume Next"
There is no error at all it just it asked for the folder selection and then msgbox "Done"

Using Outlook 2010. and there is no subfolder its in the inbox folder


----------



## ZVI (Oct 18, 2019)

vmjan02 said:


> no


The code requirs full Outlook's path from the root to the Folder with subfolders.
Could you post it?
If it is a common folder then code may not work, it depends on server configuration


----------



## vmjan02 (Oct 18, 2019)

ZVI said:


> The code requirs full Outlook's path from the root to the Folder with subfolders.
> Could you post it?
> If it is a common folder then code may not work, it depends on server configuration


vs@gmail.com\Inbox\...


----------



## ZVI (Oct 18, 2019)

And please  do you have 1 or more accounts?


----------



## DanteAmor (Oct 18, 2019)

vmjan02 said:


> did removed the code "on Error Resume Next"
> There is no error at all it just it asked for the folder selection and then msgbox "Done"
> Using Outlook 2010. and there is no subfolder its in the inbox folder




Try this please:

Run the macro and select the folder that contains the emails.


```
Sub download_attachments()
  Dim olApp As Outlook.Application, olmail As MailItem, Att As Object
  Dim olFolder As Outlook.Folder, sPath As String, y As Long, strfile As String
  sPath = ThisWorkbook.Path & "\"
  '
  Set olApp = CreateObject("Outlook.application")
  Set olmail = olApp.CreateItem(olMailItem)
  Set olFolder = olApp.GetNamespace("MAPI").PickFolder
  '
  For Each olmail In olFolder.Items
    If TypeName(olmail) = "MailItem" Then
      y = 1
      For Each Att In olmail.Attachments
        strfile = sPath & olmail.Attachments.Item(y).Filename
        olmail.Attachments.Item(y).SaveAsFile strfile
        y = y + 1
      Next Att
    End If
  Next
  MsgBox "Done"
End Sub
```


----------



## ZVI (Oct 18, 2019)

Well, does the below code work?

```
*Option* *Explicit*

*Public* *WithEvents* objInboxItems *As* Outlook.Items

' Run this code manually for the testing or reload Outlook
*Private* *Sub* Application_Startup()
   *Const* GmailAccountName = "...@gmail.com" ' <-- put gmail root folder name (actually it's gmail email)
   Set objInboxItems = Application.GetNamespace("MAPI").Folders(GmailAccountName).Folders("Inbox").Items
*End* *Sub*

*Private* *Sub* objInboxItems_ItemAdd(ByVal Item *As* Object)
  MsgBox "Ok"
  ' Your code is here
  '...
*End* *Sub*
```


----------



## ZVI (Oct 18, 2019)

The below code works with any input emails independently of input folder:

```
' Code of ThisOutlookSession
*Option* *Explicit*

*Private* *Sub* Application_Startup()
' Do nothing, but this tries to enable macros or asks to confirm it
*End* *Sub*

*Private* *Sub* Application_NewMailEx(ByVal EntryIDCollection *As* String)
  
  *Dim* objItem *As* *Object*
  *Dim* objMail *As* MailItem
  
  Set objItem = Application.GetNamespace("MAPI").GetItemFromID(EntryIDCollection)
  *If* objItem.Class <> olMail *Then* *Exit* *Sub*
  Set objMail = objItem
  
  ' This is just for the testing
  MsgBox "Message subject: " & objMail.Subject & vbLf _
       & "Message sender: " & objMail.SenderName & " (" & objMail.SenderEmailAddress & ")"
  
  ' Your code goes here
  ' ...
  
  
  ' Release memory of the object variables
  Set objItem = *Nothing*
  Set objMail = *Nothing*
  
*End* *Sub*
```


----------



## vmjan02 (Oct 20, 2019)

ZVI said:


> And please  do you have 1 or more accounts?


1 account


----------



## ZVI (Oct 20, 2019)

Does code from post 17 or 18 work?


----------



## vmjan02 (Oct 16, 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.


```
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 (Oct 20, 2019)

or #16 ?


----------



## vmjan02 (Oct 20, 2019)

DanteAmor said:


> Try this please:
> 
> Run the macro and select the folder that contains the emails.
> 
> ...



getting error on olApp As Outlook.Application -- "user-defined type not defined"


----------



## DanteAmor (Oct 20, 2019)

To automate Outlook based tasks from Excel you need to add Outlook Object Library (Microsoft Outlook XX.X Object Library) in Excel References. You can follow below steps to add Outlook reference in Excel VBA:

1. From the Menu Bar, click on Tools > References

2. Select ‘Microsoft Outlook XX.X Object Library’ and click on ‘OK’ button


----------



## ZVI (Oct 20, 2019)

vmjan02 said:


> getting error on olApp As Outlook.Application -- "user-defined type not defined"


In fact, this should not happen if the code is in the Outlook module, 
as it was mentioned in the first post:


vmjan02 said:


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


So where actually the code is? 
What version of MS Office are you using?


----------



## DanteAmor (Oct 20, 2019)

ZVI said:


> What version of MS Office are you using?




@AMvmjan02 said:


> Using Outlook 2010. and there is no subfolder its in the inbox folder


----------



## DanteAmor (Oct 20, 2019)

Another update, try this please.


```
Sub download_attachments()
  'Dim olApp As Outlook.Application, olmail As MailItem, Att As Object
  Dim olApp As Object, olmail As Object, Att As Object
  Dim olFolder As Object, sPath As String, y As Long, strfile As String
  sPath = ThisWorkbook.Path & "\"
  '
  Set olApp = CreateObject("Outlook.application")
  Set olmail = olApp.CreateItem(0)
  Set olFolder = olApp.GetNamespace("MAPI").PickFolder
  '
  For Each olmail In olFolder.Items
    If TypeName(olmail) = "MailItem" Then
      y = 1
      For Each Att In olmail.Attachments
        strfile = sPath & olmail.Attachments.Item(y).Filename
        olmail.Attachments.Item(y).SaveAsFile strfile
        y = y + 1
      Next Att
    End If
  Next
  MsgBox "Done"
End Sub
```


----------



## vmjan02 (Oct 21, 2019)

ZVI said:


> In fact, this should not happen if the code is in the Outlook module,
> as it was mentioned in the first post:
> 
> So where actually the code is?
> What version of MS Office are you using?



Code is not in outlook module. and version is 2010


----------



## ZVI (Oct 21, 2019)

vmjan02 said:


> Code is not in outlook module. and version is 2010


Thanks for the clarification, but please bear in mind that my code posted in this thread should be in the ThisOutlookSession Outlook's module.


----------



## DanteAmor (Oct 21, 2019)

Hi @vmjan02,
Did you try the codes again? in post #26  or the previous code with the reference update.


----------



## vmjan02 (Oct 22, 2019)

ZVI said:


> Thanks for the clarification, but please bear in mind that my code posted in this thread should be in the ThisOutlookSession Outlook's module.


yes. its there only.


----------



## vmjan02 (Oct 16, 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.


```
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
```


----------



## vmjan02 (Oct 22, 2019)

DanteAmor said:


> Another update, try this please.
> 
> 
> ```
> ...



ERROR IS IN Next. cannot save the attachments as user don not have the permission. 
I am surprised.


----------



## ZVI (Oct 22, 2019)

vmjan02 said:


> yes. its there only.


And does message box appear?


----------



## vmjan02 (Oct 22, 2019)

Yes, now I am able to download the attachments. the problem was with my outlook, so had to ask the IT guy and ye had fixed it. So now all good and cool.
the problem as the access of mail(MIPA), now its all good

@ZVI thanks a tone for all the support. @Dante Thanks a tone to you as well. 

You both rock. great guys. Will keep in touch with you both


----------



## DanteAmor (Oct 22, 2019)

@vmjan02, I'm glad to know that it works for you now. Thanks for the feedback.


----------



## vmjan02 (Oct 22, 2019)

@Dante and @Zvi,

can you check on my new thread "[h=3]"Miuns Non Working Hours"[/h]


----------

