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,
Related
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.
Main problem it only renames the first attachment and I have no control over the other items in the email.
This code saves my attachment and renames it. It works IF the email has only one attachment and no images in signature. If the email comes with one Excel file and an image in signature, it renames the image what I intended to be the Excel file name, and then leaves the Excel file with its original name.
Would be awesome if I can also dictate specific extensions in the save.
Public Sub saveAttachtoDisk_Vendor(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName
Dim file As String
Dim DateFormat As String
Dim newName As String
Dim enviro As String
saveFolder = "S:\Test\"
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each objAtt In itm.Attachments
file = saveFolder & objAtt.DisplayName
objAtt.SaveAsFile file
Set oldName = fso.GetFile(file)
DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
newName = "Vendor.xls"
oldName.Name = newName
Set objAtt = Nothing
Next
Set fso = Nothing
End Sub
I am toying with these codes but cant get them to work.
validExtString = ".doc .docx .xls .xlsx .msg .pdf .txt" ' <---- Update as needed
validExtArray = Split(validExtString, " ")
And this.
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "C:\Email Attachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Be aware, the folder can't contain files with the same name. You need to use different names for attachments.
For Each objAtt In itm.Attachments
The code iterates over all attachments and save them on the disk. It looks like an error in code doesn't allow to get the job done.
I'd recommend running the code in the step-by-step manner (F8) and see what happens in the code running it under the debugger. See Getting Started with VBA in Outlook 2010 for more information.
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.
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?