• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Outlook Attachment Download VBA edit

P

plexus

New Member
Hi Guys,

I have an Outlook VBA script that works fine for me when the attachments have different names. The script lets me select the folder to extract the attachments from then copy them into a folder.

I now have a daily email that, unfortunately has the same name in the attachment. When I run my script in the folder containing multiple daily emails, the script only extracts the latest attachment and ignores the rest of the email in the folder.

I want to modify the script to be able to download each attachment for each daily email.

The script I am using is this:

Code: 
Sub Shortage_Attachments()



  Dim ns As NameSpace

  Dim Inbox As MAPIFolder

  Dim SubFolder As MAPIFolder

  Dim item As Object

  Dim Atmt As Attachment

  Dim fileName As String

  Set ns = GetNamespace("MAPI")

  Set Inbox = ns.GetDefaultFolder(olFolderInbox)

  Set SubFolder = Application.Session.PickFolder ' Enter correct subfolder name.

  On Error Resume Next



  For Each item In SubFolder.Items

  For Each Atmt In item.Attachments

  fileName = "S:\ALL\Planning Team\Weekly Metrics\2017 Weekly_Metrics_Rebuild_V2\Weekly Metrics Reports\Clean Reports\SHORTAGE TEST\" & _

  Atmt.fileName

  Atmt.SaveAsFile fileName

   Next Atmt

  Next item

 

 Call MsgBox("Download Complete")

End Sub

I also need each attachment to save in the folder with the 'day' i.e Monday, Tuesday etc- as the name of the attachment. e.g: 'sql report Monday'

I do not know if this can be achieved from the itm.receivedTime or the subject heading from the mail itself.

The Subject heading contains the following text: sql report results 21/03/2017 Tuesday
Obviously the day value changes daily.

The date format in the mail is: Mon 20/03/2017 00:15
 
Monty said:
plexus

Good question.

Only person i strongly believe can help is Deepak who is really good at Outlook vba..am big fan of him.


Monty!
Click to expand...

Thanks for the reply. Outlook VBA is a strange beast for sure. Not having much luck around the web getting a solution to this from the Outlook VBA priests.

Guess I am waiting for Deepak the savior then :)
 
plexus said:
Hi Guys,

I now have a daily email that, unfortunately has the same name in the attachment. When I run my script in the folder containing multiple daily emails, the script only extracts the latest attachment and ignores the rest of the email in the folder.
Click to expand...

That might got replaced not skipped.

Try it.

Code: 
Const sPath As String = "S:\ALL\Planning Team\Weekly Metrics\2017 Weekly_Metrics_Rebuild_V2\Weekly Metrics Reports\Clean Reports\SHORTAGE TEST\"
Sub Shortage_Attachments2()
Dim ns As Namespace
Dim Inbox As MAPIFolder, SubFolder As MAPIFolder
Dim item As Object
Dim Atmt As Attachment
Dim fileName As String

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Application.Session.PickFolder ' Enter correct subfolder name.

On Error Resume Next

For Each item In SubFolder.Items
    For Each Atmt In item.Attachments
        fileName = Atmt.fileName
        If Len(Dir(sPath & fileName)) > 0 Then fileName = _
        sPath & Format(item(i).ReceivedTime, "DDMMYYYY") & "_" & Format(Now, "DDMMYYHHMMSS") & fileName
            Atmt.SaveAsFile fileName
    Next Atmt
  Next item

MsgBox "Download Complete.", vbInformation, "SUCCESS"

End Sub
 
Deepak said:
That might got replaced not skipped.

Try it.

Code: 
Const sPath As String = "S:\ALL\Planning Team\Weekly Metrics\2017 Weekly_Metrics_Rebuild_V2\Weekly Metrics Reports\Clean Reports\SHORTAGE TEST\"
Sub Shortage_Attachments2()
Dim ns As Namespace
Dim Inbox As MAPIFolder, SubFolder As MAPIFolder
Dim item As Object
Dim Atmt As Attachment
Dim fileName As String

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Application.Session.PickFolder ' Enter correct subfolder name.

On Error Resume Next

For Each item In SubFolder.Items
    For Each Atmt In item.Attachments
        fileName = Atmt.fileName
        If Len(Dir(sPath & fileName)) > 0 Then fileName = _
        sPath & Format(item(i).ReceivedTime, "DDMMYYYY") & "_" & Format(Now, "DDMMYYHHMMSS") & fileName
            Atmt.SaveAsFile fileName
    Next Atmt
  Next item

MsgBox "Download Complete.", vbInformation, "SUCCESS"

End Sub
Click to expand...

---------

Good Afternoon,
I'm just new user to this Website and a very humble scavenger for VBA, your above reply to the original VBA didn;t work for me, my intention is to have the same action the original VBA did but with exchanging the attachment name with the received date for its mail, for example i receive to mails on 1st of Dec and another on 5th of Dec with the same attachment named same, so i need to download both by exchanging their names to be as "XYZ-01-12-2019.xls" & "XYZ-05-12-2019.xls", plz don't reply me in hard VBA , abbreviations, as i told you i'm only a scavenger :)
 
Ahmed ElGammal said:
---------

Good Afternoon,
I'm just new user to this Website and a very humble scavenger for VBA, your above reply to the original VBA didn;t work for me, my intention is to have the same action the original VBA did but with exchanging the attachment name with the received date for its mail, for example i receive to mails on 1st of Dec and another on 5th of Dec with the same attachment named same, so i need to download both by exchanging their names to be as "XYZ-01-12-2019.xls" & "XYZ-05-12-2019.xls", plz don't reply me in hard VBA , abbreviations, as i told you i'm only a scavenger :)
Click to expand...
I've found this (https://www.pixelchef.net/content/rule-autosave-attachment-outlook ) with a match to my quest, but i can't construct the full script
 
You must log in or register to reply here.
Back
Top