How to automatically save an attachment, with overwrite? - vba

Question

I'm trying to extract an Excel report from an Outlook email, and save it in a folder called "OLAttachments" in my Documents folder.
I also need it to overwrite the previous day's file. These email attachments have the same name each day.
This is what I have so far. Each time the email comes through, it saves a new file, whereas I would like to overwrite the existing file.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\fmustapha\Documents\Outlook Attachments"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

Answer 1

I do this on my server, I receive an email each night that has an Excel file attached, that auto forwards to my server where this outlook code saves off the attachment. Note there is a clause in there to make sure the file comes from me and to make sure it's an Excel file:
Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set olItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim NewMail As Outlook.MailItem
Dim Atts As Attachments
Dim Att As Attachment
Dim strPath As String
Dim strName As String
If Item.Class = olMail Then
Set NewMail = Item
End If
strPath = "C:\Reporting Archive\Sales Files\"
If NewMail.Sender = "Dan Donoghue" Then
Set Atts = Item.Attachments
If Atts.Count > 0 Then
For Each Att In Atts
If InStr(LCase(Att.FileName), ".xls") > 0 Then Att.SaveAsFile strPath & Att.FileName
Next
End If
End If
End Sub
It goes in ThisOutlookSession in the VBE, once you have put it in close and reopen outlook and it will work.
To save over the top I would recommend you delete the existing file first (you can use the kill command for this then simply save the new one).
You would do that by replacing this:
If InStr(LCase(Att.FileName), ".xls") > 0 Then Att.SaveAsFile strPath & Att.FileName
with this:
If InStr(LCase(Att.FileName), ".xls") > 0 Then
Kill strPath & Att.FileName
Att.SaveAsFile strPath & Att.FileName
End If
in my code

Answer 2

You can setup a rule that triggers this job in any frequency you want (you probably don't want the rule to run in seconds, but more like 1x per day, overnight, etc.)
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\DT168\Documents\outlook-attachments\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
https://www.extendoffice.com/documents/outlook/3747-outlook-auto-download-save-attachments-to-folder.html#a1

Answer 3

Try using Date function Which Returns a Variant (Date) containing the current system date. MSDN
Example
oAttachment.SaveAsFile sSaveFolder & "New Members" & " " & Format(Date - 1, "MM-DD-YYYY")