Auto-Save Outlook attachments using received date (Minus 1 Calendar Day) - vba

Background: I receive several daily Infection Control Reports in pdf format from our electronic medical records system via Outlook email attachments.
Request: Given the large number of reports, I am trying to find a way to autosave the attachments using an outlook rule.
Currently, the code I use works only to save the attachment with its respective received date. However, these medical reports largely reflect the previous day's data. Therefore, I was wondering, How would I format this code so that it will take the email attachment's received date less (minus) 1 day, and autosave it in a specified location?
Here is what I have so far:
Sub Save_DailyFluReport(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim dateFormat As String
Dim saveFolder As String
dateFormat = Format(itm.ReceivedTime, "dd-mmmm-yyyy")
saveFolder = "Z:\Infection Control\IP Daily Surveillance Reports"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - " & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

I figured it out! Hope this solution can help someone else in the future.
Sub Save_DailyFluReport(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim dateFormat As String
Dim saveFolder As String
dateFormat = Format(DateSerial(Year(itm.ReceivedTime), Month(itm.ReceivedTime), Day(itm.ReceivedTime) - 1), "dd-mmmm-yyyy")
saveFolder = "Z:\Infection Control\IP Daily Surveillance Reports"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - Daily Flu Report.pdf"
Set objAtt = Nothing
Next
End Sub

Related

Outlook Rules VBA Run a Script - Multiple Rules

How can I have multiple 'scripts' available to run multiple rules? The only code that appears available to run with Rules/run a script..is the code pasted in ThisOutlookSession. The modules below do not appear.
I have Outlook 2010 on windows 11.
I'm accounts payable for my company.
All my invoices (many!) come in my email.
What I'm trying to do: I have many vendors, I want to create rules that will automatically save the attachments from specific vendors to the correct folder. I want to be able to set a rule to save attachments that come from joeshmo's email to the joeshmo folder in My Documents.
What I CAN do: I have a couple working codes:
I have a code where i can select emails, run the macro and all attachments are saved to the same folder.
I have a code that i can use in a rule.
I did have to re-enable scripts for my version of outlook.
So I go to Rules, I set conditions, choose "run a script" and in the drop down, only 1 code is available to run, and that is whatever is pasted into "ThisOutlookSession". When I open visual basic, there is a list of Modules but none of them appear in Run a script. Nor can I move them up there. I can only paste one code. Below is an example of the code.
I wanted to create a Rule and accompanying script per Vendor to run automatically. So all the incoming emails with invoices are automatically saved to their folder.
Am i asking too much? i can save all attachments to the same folder and then sort.
Or I can create rules to assign categories to each vendors email and then sort alphabetically...meaning, I can select all the "A" vendors, run the macro, Select the "B" vendors, etc.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:\Users\jenny\Documents\Attachments\outlook testing\test number one"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
Any ideas? thanks
"Run a script" expects the incoming item as input.
Code must start with something like Sub somename(itm As Object).
You could create code for each vendor.
Public Sub saveAttachtoDisk_Sender1(itm As Object)
' Rule conditions: from Sender1 with attachment
Dim objAtt As Attachment
Dim saveFolder As String
Dim dateFormat As String
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:\Users\jenny\Documents\Attachments\outlook testing\test number one"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Next
End Sub
Public Sub saveAttachtoDisk_Sender2(itm As Object)
' Rule conditions: from Sender2 with attachment
Dim objAtt As Attachment
Dim saveFolder As String
Dim dateFormat As String
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:\Users\jenny\Documents\Attachments\outlook testing\test number two"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Next
End Sub
A single rule may be preferable:
Public Sub saveAttachtoDisk_VariousSenders(itm As Object)
' Rule condition: with attachment
Dim objAtt As Attachment
Dim saveFolder As String
Dim dateFormat As String
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
Debug.Print itm.senderEmailAddress
Select Case itm.senderEmailAddress
Case "sender1#someplace.com"
saveFolder = "C:\Users\jenny\Documents\Attachments\outlook testing\test number one"
Case "sender2#someplace.com"
saveFolder = "C:\Users\jenny\Documents\Attachments\outlook testing\test number two"
Case Else
Debug.Print itm.senderEmailAddress & " not listed."
End Select
Debug.Print saveFolder
If saveFolder <> "" Then
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Next
End If
End Sub

Automated Outlook Attachment Download with Email Date

I am hoping someone in here can help me with this request. I have found code shared by someone at https://www.pixelchef.net/content/rule-autosave-attachment-outlook that would help me setup a rule to automatically download attachments based on a rule.
The code is working fine but I want to tweak it to instead of naming the files like this 2021-08-28 10-00Test to format the name of the file like this Test_2021-08-28 10-00. The code is also at the moment adding the time stamp based on when the rule runs. I want to change it to instead pick up the date and time from the email.
Here is the code:
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:\path"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
Any help is appreciated.
You can use the MailItem.ReceivedTime property which returns a Date indicating the date and time at which the item was received.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd H-mm")
saveFolder = "C:\path"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
There are two additional aspects I've noticed in your code:
Your rule can process all kind of Outlook items - appointments, meeting requests, documents, mail and etc. So, it makes sense to add a type check to prevent any unexpected results when dealing with unsupported item types.
Make sure the file name of the attached file has a unique name to save with. The folder can't contain two files with the same name while emails may contain two attachments with the same display name.

Rule to save attachments to file with today's date

I'm trying to put together some VBA that will save an attachment that I get sent daily to a folder on my network, I've got as far as the attachment being saved to the correct location, however, I want to prefix the document with the date in which it was saved.
The attachment is summary.rtf and I'd like it to be 20160805_summary.rtf etc.
My VBA are essentially NOTHING (I'm a SQL girl), so any simple advice would be so greatly appreciated, I've been revisiting this for days and can't find any help anywhere!
My current code looks like this:
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "X:\Tessitura\Shared Full Access\Secure_CXL_Reports"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
I would be so grateful for any extra help!
You need to add the below section into the line, format will change the form of your date to the one required and date will return the current date, change the y/d/m for the format as required.
format(date, "yyyymmdd")
This is the line inserted into your code.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "X:\Tessitura\Shared Full Access\Secure_CXL_Reports"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & format(date, "yyyymmdd") & "_" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

Splitting up a field in OUTLOOK

Basically the script below works along with a rule in OUTLOOK. When I receive the email it saves the PDF attachment. The problem I am having is I want to change the file name (objAtt.SaveAsFile). The file name that it comes in as is something like “userid.jobname.JOB22979……..”. I would like to save the file using the second node (jobname in this case), followed by the date and time. I believe I can get the file name from object objAtt.DisplayName, but I don’t know how to pick up just the second node in the file name.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm-ss")
saveFolder = "c:\users\xxxxxx\USER\documents\email\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & dateFormat & "print.pdf"
Set objAtt = Nothing
Next
End Sub
Split to pull out the 2nd token;
DisplayName = "userid.jobname.JOB22979.blah"
job = Split(DisplayName & ".", ".")(1)
If Len(job) > 0 Then
job = job & "_" & Format$(Now, "yyyy-mm-dd H-mm-ss") & "_print.pdf"
Else
'// no match, use original
job = DisplayName
End If
objAtt.SaveAsFile saveFolder & job

How do I save an attachment from an Outlook email retaining the date time stamp of the attachment

I am trying to use a script and rule in Outlook to automatically file an attachment. It works but instead of using the attachment's date time, it uses the current datetime.
Here is my script:
Public Sub saveFedhealthstatement(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
Dim subject
subject = itm.subject
saveFolder = "f:\filing\fedhealth"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & subject & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub