I have save attachment VBA code for Outlook. It doesn't process if I receive an attachment with the same name. How do overwrite and save the latest?
Sub ExportAttach(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Users\Redirection\johndoe\Desktop\TestFolder"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
One method would be: construct the destination file name first, check if the file exists, if yes delete the file and then save the file.
Dim FN as String
FN = SaveFolder & "\" & objAtt.DisplayName
if (Dir$(fn) <> "") then kill fn ' delete if file exists
objAtt.saveAsFile fn
Related
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
I have code to save all attachments in a specific folder.
When I run it on a selected email, I get an error due to Outlook.MailItem being empty.
Does this need a modification to work with selected items instead of an email fetched by a rule?
Public Sub saveAttachtoDisk2(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Set Totalmsg = itm.ReceivedTime
saveFolder = "C:\path\to\file"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & Totalmsg & "." & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
Try this:
For Each objAtt In itm.Attachments
If Not objAtt Is Nothing Then
objAtt.SaveAsFile saveFolder & "\" & Totalmsg & "." & objAtt.DisplayName
End If
Next
Note: There's no need to Set objAtt = Nothing for objAtt will be assigned a new value in the next loop and/or released at all when exiting sub.
You can initialize the itm variable by setting it to Application.ActiveExplorer.Selection.Item(1) (error checking omitted)
I run below script to save Outlook attachment on arrival of email. But I frequently get Run-time error '-2147024864 (80070020), which will always stop the inflow of Outlook email. Please advise how to get rid.
Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Email\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
try this code please
it prints the name of each attachment before it saves the attachment
press ctrl-G to see "immediate window" where the printout is sent
check the last file name printed when the program crashes
it may provide some insight
Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Email\"
For Each objAtt In itm.Attachments
debug.print objAtt.DisplayName ' print attachment name to "immediate window"
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Next
Set objAtt = Nothing
End Sub
I have a fairly straight forward scenario where I get an email every day with a zip file attached and I would like to be able to more easily parse this information. In order to do so I just need to be able to download the attachment to a folder and then extract it.
To download the attachment I did the following
Public Sub SaveZip(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
This works as expected, the .zip file gets dumped into the temp directory. I found the following code which on all accounts seems to be what I need to implement in order to extract the .zip
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(saveFolder).CopyHere oApp.NameSpace.Items
I have not been able to implement this into my existing code without generating a host of errors (due to my own lack of understanding I am sure)
Any input on this would be greatly appreciated
Final Edit
Got it, thanks to Tim for all the help. The following will download attachments (always named the same thing) from an incoming email into c:\temp, extract them to c:\temp\unzipped, rename the file, and finally delete the .zip in c:\temp.
Public Sub SaveZip(itm As Outlook.MailItem)
Const saveFolder = "C:\Temp\"
Const fileFolder = "C:\CBH\"
Dim objAtt As Outlook.Attachment
Dim oApp As Object
Dim dName As Variant
For Each objAtt In itm.Attachments
dName = objAtt.DisplayName
objAtt.SaveAsFile saveFolder & dName
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace("C:\CBH").CopyHere _
oApp.NameSpace(saveFolder & dName).Items
Name fileFolder & "CallsByHour.xls" As fileFolder & "CBH-" & Format(Date, "yyyymmdd") & ".xls"
Kill saveFolder & dName
Next
End Sub
Assuming you're coding in Outlook, this will process the item selected in Outlook, saving the attachment to C:\Temp and extracting the zip contents to C:\Temp\unzipped
EDIT (untested) - added date-time based subfolder
Sub Tester()
SaveZip Application.ActiveExplorer.Selection.Item(1)
End Sub
Public Sub SaveZip(itm As Outlook.MailItem)
Const saveFolder = "C:\Temp\"
Dim objAtt As Outlook.Attachment
Dim oApp As Object
Dim dName As Variant, unZipFolder
If itm.Attachments.Count > 0 Then
unZipFolder = saveFolder & "unzipped\" & " _
Format(Now,"yyyymmdd_hhmss")
MkDir unZipFolder
For Each objAtt In itm.Attachments
dName = objAtt.DisplayName
objAtt.SaveAsFile saveFolder & dName
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(unZipFolder).CopyHere _
oApp.NameSpace(saveFolder & dName).Items
Next
End If 'any attachments
End Sub
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