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

 

[vmjan02]

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 <------------- ERROR IS HERE AS 
  MsgBox "Done"
End Sub

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

 

[ZVI]

yes. its there only.

And does message box appear?

 

[vmjan02]

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]

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

 

[vmjan02]

@Dante and @Zvi,

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