I have no prior experience in VBA and found a solution to the first part of my question here.
So, I was able to make the "Save Excel attachment"-part work with the code below.
Now, since the attachment is a .xls file and gives me a corrupted file message when opening (other worksheets pull data from this saved file), I would like to save it automatically as a .xlsx file.
I tried to find a solution but the things I have tried would not work. Hope to find some help here. Any help would be appreciated! Thanks in advance!
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(itm.ReceivedTime - 1, "yyyymmdd_")
saveFolder = "THIS IS MY FOLDER"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
You specify fileFormat like this
ActiveWorkbook.SaveAs fileFormat:=xlWorkbookDefault
or
ActiveWorkbook.SaveAs fileFormat:=51
http://msdn.microsoft.com/en-us/library/office/ff840717(v=office.14).aspx
File Formats here:
http://msdn.microsoft.com/en-us/library/bb241279.aspx
http://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.xlfileformat.aspx?
Related
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.
I am trying to save a Excel (.xlsm) file which is in an email. I get this email through another email.
I want to download the said .xlsm file to a shared drive. Looking up multiple online forums and MSDN help I wrote the following code:
When I run this code I don't get any error. Nor are any files saved.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim msgAtt As Outlook.Attachment
Dim saveFolder As String
' a to i are dummy names and have been replaced with correct folder path in real code
saveFolder = "\\a\b\c\d\e\f\g\h\i"
For Each objAtt In itm.Attachments
If InStr(objAtt.DisplayName, ".msg") Then
For Each msgAtt In itm.Attachments
If InStr(msgAtt.DisplayName, ".xlsm") Then
msgAtt.SaveAsFile saveFolder & "\" & msgAtt.DisplayName
End If
Next
Set msgAtt = Nothing
End If
Next
Set objAtt = Nothing
End Sub
I found the solution while I run the code line by line.
The if statement says to look for ".msg" and ".xlsm" word in the displayname of the attachment. On investigation, the display name don't take file extension into display name.
Hence to solve this, ".msg" and ".xlsm" had to be replaced by the file name.
Thanks,
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.
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.
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.