Try using the code below as the basis for trapping items delivered or saved
to any folder. The Item_Add event will fire when an e-mail is moved to the
folder that you specify, and then you can work with the message in any way
you want. Keep in mind that the Item_Add event is flaky and may not fire if
a large number of messages are moved/copied/delivered to a folder at the same
time.
Once you've done that and have a handle to the message object you want, call
MailItem.Attachments(1).SaveAsFile("C:\" &
MailItem.Attachments.Item(1).DisplayName (change the number as appropriate).
You'd then need to use the Excel object model to open that worksheet and run
a macro.
For more general info on Outlook programming, there are some good resources
here:
Visual Basic and VBA Coding in Microsoft Outlook:
http://www.outlookcode.com/d/vb.htm
'--------------------------------------------------------------------------Â-------------
' Module : clsMailItemTrapper
' Usage :
' : In the ThisOutlookSession module, you must instantiate this
class properly
' : so it will run while Outlook is open
'
' e.g.:
' Dim myTrapper As clsMailItemTrapper
'
' Private Sub Application_Startup()
' Set myTrapper = New clsMailItemTrapper
' End Sub
' Private Sub Application_Quit()
' Set myTrapper = Nothing
' End Sub
'--------------------------------------------------------------------------Â-------------
Option Explicit
Dim WithEvents objMonitoredFolderItems As Outlook.Items
Private objMonitoredFolder As Outlook.MAPIFolder
Private objNS As Outlook.NameSpace
Private Sub Class_Initialize()
On Error GoTo EH:
Set objNS = Application.GetNamespace("MAPI")
'Method 1: if you know the EntryID for the folder...
Set objMonitoredFolder =
objNS.GetFolderFromID("000000003F89017490AEDA4098A93E729EC138D402890000")
'Method 2: set to a default folder
Set objMonitoredFolder = objNS.GetDefaultFolder(olFolderInbox)
'Method 3: if you know the full path to the folder
Set objMonitoredFolder = OpenMAPIFolder("PST
Name\RootFolderName\SubFolder")
Set objMonitoredFolderItems = objMonitoredFolder.Items
EH:
If Err.Number <> 0 Then
Exit Sub
End If
End Sub
Private Sub Class_Terminate()
Set objMonitoredFolder = Nothing
Set objMonitoredFolderItems = Nothing
Set objNS = Nothing
End Sub
Private Sub objMonitoredFolderItems_ItemAdd(ByVal Item As Object)
On Error GoTo EH:
If Item.Class <> olMail Then Exit Sub
Dim objMail As Outlook.MailItem
Set objMail = Item
'Do something with the message
Set objMail = Nothing
EH:
If Err.Number <> 0 Then
Resume Next
End If
End Sub
'**************************************************************************Â****
'Custom procedure: OpenMAPIFolder(ByVal strPath)
'Purpose: Return a MAPIFolder from Path argument
'Returns: MAPIFolder object
'**************************************************************************Â****
Function OpenMAPIFolder(ByVal strPath) As Outlook.MAPIFolder
On Error GoTo OpenMAPIFolder_Error
Dim objFldr As Outlook.MAPIFolder
Dim strDir As String
Dim strName As String
Dim i As Integer
If strPath = "" Then Exit Function
If Left(strPath, Len("\")) = "\" Then
strPath = Mid(strPath, Len("\") + 1)
Else
Set objFldr = ActiveExplorer.CurrentFolder
End If
While strPath <> ""
i = InStr(strPath, "\")
If i Then
strDir = Left(strPath, i - 1)
strPath = Mid(strPath, i + Len("\"))
Else
strDir = strPath
strPath = ""
End If
If objFldr Is Nothing Then
Set objFldr = objNS.Folders(strDir)
On Error GoTo 0
Else
Set objFldr = objFldr.Folders(strDir)
End If
Wend
Set OpenMAPIFolder = objFldr
On Error GoTo 0
Exit Function
OpenMAPIFolder_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
OpenMAPIFolder"
End Function
