Outlook 2013 script to save attachments then move email to folder - vba

I need a simple script for Outlook 2013 for a mailbox that customers send documents too.
I'm going to set a rule that that applies to all incoming mail. If the email has an attachment, it needs to be save to a folder. Then the mail, that the attachment was saved from, needs to be moved to a completed folder.
I think this is really simple, but I don't know much about VBA or Outlook scripting. I found this script, which removes the attachment and adds a date to the saved file, which is perfect.
I just need it to then move the completed email to a folder.
hopefully someone can help out.
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 = "\\myfilepath\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

The Movemethod of the MailItem class can be used to get the job done.

Related

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.

Saving and renaming an Outlook attachment with static name

I have this code which saves an attachment to a specific place and renames it to "name.xls"
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Users\acheng\Desktop"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\name.xls"
Set objAtt = Nothing
Next
End Sub
A user did something very similar in this thread with .csv files:
VBA Outlook - Rename attachments and save to folder
I did the same thing, except with a .xls file.
My script saves and renames the file, but when I try to open the file it says: "'name.xls' is in a different format than specified by the file extension. Verify that it is not corrupt..."
Once I hit Yes and it opens, all the data is in weird symbols. If I replace & '\name.xls' with '& objAtt.DisplayName' it will properly save the file with it's original name.
I have double checked that this is a .xls file. Figuring out something more universal (so that the same script works for .xls .xlsx and .xlsm) would also be hugely helpful, but not as big a priority.
If there is more than one attachment, your code might replace the Excel attachment with one of the other attachments.
Try something like this, to find out
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim i as Integer
i=0
saveFolder = "C:\Users\acheng\Desktop"
For Each objAtt In itm.Attachments
i = i + 1
objAtt.SaveAsFile saveFolder & "\name" & i & ".xls"
Set objAtt = Nothing
Next
End Sub
You should add some validation here. Assuming that all attachments are Excel files is a big risk.

Auto-save attachments in Outlook 2010

My goal is to be able to save attachments from a specific email address to a folder locally. I have created a VB script but for some reason it doesn't work.
Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "dd-mm-yyyy H-mm")
saveFolder = "c:\temp\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormate & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
I've tried to created a new module and a new rule so it will run the script when the message arrives from the specific address. I have also tried to put the script in "ThisOutlookSession" but nothing works.
Did you try to run the script manually under the debugger?
Try to choose another drive. The C: drive requires admin privileges for writing.
You may find the Getting Started with VBA in Outlook 2010 article helpful.

Run Outlook VBA code without being logged into the client

I have VBA code in a non-person mailfile. I need it to run without anyone being logged into that Outlook account. It saves Excel attachments to a network share (see below). It is currently set to run as a rule against all new incoming mails.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "mmdd H-mm")
saveFolder = "C:\Test\One"
For Each objAtt In itm.Attachments
If Right(objAtt.FileName, 3) = "xls" Or Right(objAtt.FileName, 4) = "xlsx" Then
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
End If
Next
End Sub
Is it possible to automate this rule to run without being logged into an Outlook client?
You cannot.
"Because Outlook Visual Basic for Applications code runs on the client, Outlook must be running for the code to run."
http://support.microsoft.com/kb/324568

Rule to save attachments on incoming emails not working on a fresh install of Outlook

We're migrating from one server to another and a VBA script to save attachments that was working has given up the ghost on the new server.
This is a fresh install of Outlook.
Script below:
Public Sub saveAttachmentAll(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "D:\www\phones"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
I've tested the Outlook rule and Outlook is performing other actions on it but this script isn't working!
So it turns out I had to disable macro security (which isn't the best) and restart Outlook. Fairly simple, but I was scratching my head for a while...!