Wednesday, March 23, 2011 7:51 PM
I have the following code:
Sub Test() Dim arg1 As String Dim arg2 As String Dim arg3 As String arg1 = "Trekker" arg2 = "XLS" arg3 = "C:\Trekker" 'If you use "" it will create a date/time stamped 'folder for you in the "My Documents" folder. 'Note: If you use this "C:\Users\Ron\test" the folder must exist SaveEmailAttachmentsToFolder arg1, arg2, arg3 End Sub Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _ ExtString As String, DestFolder As String) Dim ns As NameSpace Dim Inbox As MAPIFolder Dim SubFolder As MAPIFolder Dim Item As Object Dim Atmt As Attachment Dim FileName As String Dim MyDocPath As String Dim I As Integer Dim wsh As Object Dim fs As Object Dim createtime As String On Error GoTo ThisMacro_err Set ns = GetNamespace("MAPI") Set Inbox = ns.GetDefaultFolder(olFolderInbox) Set SubFolder = Inbox.Folders(OutlookFolderInInbox) I = 0 ' Check subfolder for messages and exit of none found If SubFolder.Items.Count = 0 Then MsgBox "There are no messages in this folder : " & OutlookFolderInInbox, _ vbInformation, "Nothing Found" Set SubFolder = Nothing Set Inbox = Nothing Set ns = Nothing Exit Sub End If 'Create DestFolder if DestFolder = "" If DestFolder = "" Then Set wsh = CreateObject("WScript.Shell") Set fs = CreateObject("Scripting.FileSystemObject") MyDocPath = wsh.SpecialFolders.Item("mydocuments") DestFolder = MyDocPath & "\" & Format(Now, "dd-mmm-yyyy hh-mm-ss") If Not fs.FolderExists(DestFolder) Then fs.CreateFolder DestFolder End If End If If Right(DestFolder, 1) <> "\" Then DestFolder = DestFolder & "\" End If ' Check each message for attachments and extensions For Each Item In SubFolder.Items For Each Atmt In Item.Attachments If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then createtime = Format(Item.CreationTime, "d-mmm-yy") & " " & Format(Item.CreationTime, "HhNnSs AM/PM") FileName = DestFolder & Item.SenderName & " " & createtime & " " & Atmt.FileName Atmt.SaveAsFile FileName I = I + 1 End If Next Atmt Next Item ' Show this message when Finished If I > 0 Then MsgBox "You can find the files here : " _ & DestFolder, vbInformation, "Finished!" Else MsgBox "No attached files in your mail.", vbInformation, "Finished!" End If ' Clear memory ThisMacro_exit: Set SubFolder = Nothing Set Inbox = Nothing Set ns = Nothing Set fs = Nothing Set wsh = Nothing Exit Sub ' Error information ThisMacro_err: MsgBox "An unexpected error has occurred." _ & vbCrLf & "Please note and report the following information." _ & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _ & vbCrLf & "Error Number: " & Err.Number _ & vbCrLf & "Error Description: " & Err.Description _ , vbCritical, "Error!" Resume ThisMacro_exit End Sub It is created in outlook vba and I received it from http://www.rondebruin.nl/mail/folder2/saveatt.htm. It runs correctly, but it is not done automatically. I have to hit alt + f11 and then run the macro. How can I convert this to a script and automatically run when the rule is initiated? Thanks!
Wednesday, March 23, 2011 9:17 PM
At which point do you want it to automatically run?
You need to create a handler for the event you want to trigger the method call.
Like say upon adding an attachment or sending the email.
Thursday, March 24, 2011 1:02 PM
Thanks for replying!!!. I need to this macro run when I have an email arrive in the "Trekker" folder under my inbox. I am new to Outlook scripting and event handling. Can you please provide an example.
Thursday, March 24, 2011 1:27 PM
I found out how to do event handling. I have the handler:
Private Sub Application_NewMail()
However, this fires everytime an item arrives in my inbox. How may I alter this so it only fires when an item arrives in a particular subfolder?
Thursday, March 24, 2011 1:42 PMModerator
NewMail() and the more recent NewMailEx() do only run on additions to Inbox.
Get the subfolder as a Folder or MAPIFolder, then get a reference to that folder's Items collection and set up an event handler for the ItemAdd() event for that Items collection. That would do the trick.
Ken Slovak MVP - Outlook
Thursday, March 24, 2011 3:51 PM
Thanks for your reply!
So this is what my thisoutlooksession looks like now:
However, it still does not fire... Do I have to put something in the application_newmail routine? or am i doing this wrong?
Dim myOlApp As New Outlook.Application Public WithEvents myOlItems As Outlook.Items Public Sub Initialize_handler() Set myOlItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Trekker") End Sub Private Sub myOlItems_ItemAdd(ByVal Item As Object) Call Test End Sub Private Sub Application_NewMail() End Sub
Thursday, March 24, 2011 5:47 PMModerator
Unless you actually want to handle new items to Inbox you don't need NewMail() at all. If you want to handle that you are far better off with NewMailEx(), which doesn't miss items coming in as NewMail() does.
Are you calling the Initialize_handler() method to initialize things? Call it either manually or from the Application_Startup() event handler or from some other method.
Ken Slovak MVP - Outlook
- Marked As Answer by dbansal Thursday, March 24, 2011 6:32 PM
Thursday, March 24, 2011 6:31 PM
Thanks!!! That worked perfect!! NewMail() stinks!!!
this is my code now:
Dim myOlApp As New Outlook.Application
Public WithEvents myOlItems As Outlook.Items
Public Sub Initialize_handler()
Set myOlItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Trekker").Items
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
Private Sub Application_Startup()
- Marked As Answer by dbansal Thursday, May 05, 2011 5:44 PM
Thursday, May 05, 2011 1:02 PM
can you please write all the code?
Thursday, May 05, 2011 5:43 PMsorry!