Need to run an application after saving attachment with below script.
how do i call it After end sub?
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\New folder\tmp\"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
To open Application in VBA
Sub OpenApp()
Dim x As Variant
Dim Path As String
'// Application Path
Path = "C:\Program Files\blabla.exe"
x = Shell(Path, vbNormalFocus)
End Sub
Related
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
Basic question - I have a script that saves attachments from selected emails in outlook, I want it to save the attachments automatically when they come in instead (I'll create a rule in outlook to run the script when an email comes in), any help would be appreciated!
Public Sub script()
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim itm As Outlook.MailItem
Dim dateFormat
dateFormat = Format(Now, "yymmdd ")
saveFolder = "C:\temp"
For Each itm In ActiveExplorer.Selection
For Each objAtt In itm.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next objAtt
Next itm
End Sub
You need to pass an item as a parameter. So, the code should look like the following one:
Public Sub script(itm as Outlook.MailItem)
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim dateFormat
dateFormat = Format(Now, "yymmdd ")
saveFolder = "D:\temp"
For Each objAtt In itm.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next objAtt
End Sub
And don't save attachments on the C: drive, it requires admin privileges on the latest Windows OS. Choose another drive/folder.
I am not sure that you can use a rule for this. I think you will need to hook up an Outlook event. To do this you would use code like the following;
Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' this is for your local Inbox - if you have more inboxes you need to set it for each one
Set olItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
'You can add this because you used "WithEvents" to declare olItems
Private Sub olItems_ItemAdd(ByVal item As Object)
Dim olMailItem As Outlook.MailItem
'this event will fire for all items so you need to make sure you have a mail item.
If TypeName(item) = "MailItem" Then
Set olMailItem = item
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim dateFormat
dateFormat = Format(Now, "yymmdd ")
saveFolder = "D:\temp"
For Each objAtt In olMailItem.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next objAtt
End If
End Sub
I am getting the following error on the script below, I'm trying to set up a script that will run when activated by an outlook rule (i.e. Apply this rule after message arrives; from person#email.com; run a script) and save any attachments to a particular folder.
runtime error '91' Object variable With block variable not set
the error is against 'For Each objAtt In itm.Attachments'
Public Sub script()
Dim saveFolder As String
Dim objAtt As Outlook.attachment
Dim itm As Outlook.MailItem
Dim dateFormat
dateFormat = Format(SentOn, "yymmdd ")
saveFolder = "C:\temp"
For Each objAtt In itm.Attachments
If objAtt.Size > 5200 Then
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
End If
Next
End Sub
You didn't initialize the itm object. Try to define it as a parameter to a method in the following way:
Public Sub script(itm as Outlook.MailItem)
I have the following vba code that saves attachments in an email.
This works fine for .docx, .jpg etc but I need to use it to extract multiple .msg attachments which doesn't work.
The code is
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Test\"
For Each objAtt In itm.Attachments
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
JumpHere:
If Dir(stFileName) = "" Then
objAtt.SaveAsFile stFileName
Else
i = i + 1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
GoTo JumpHere
End If
Set objAtt = Nothing
Next
End Sub
The error concerns the line - If Dir(stFileName) = "" Then
Following our chat, here is the final code :
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim i As Integer
saveFolder = "C:\Test\"
For Each objAtt In itm.Attachments
stFileName = saveFolder & objAtt.FileName
i = 0
'Loop to find the first available filename
Do While Dir(stFileName) <> ""
i = i + 1
stFileName = saveFolder & i & " - " & objAtt.FileName
Loop
objAtt.SaveAsFile stFileName
Next
End Sub
Regards,
Max