Hello All,

I have a cobbled together code that basically looks for an email from a specific sender with a specific subject line. Once that email is received then my code saves the attachment to the designated folder and the kicks off some macros in Access.

My problem/question is this.. How can I modify this code so that I can run the process on different different senders sending different attachments. This would all be excel attachments.

I would like to be able to specify a save to folder for each individual sender, but if I can not I could create a single Inbound Attachments folder.

Here is my code:


Private WithEvents Items 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")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)


On Error GoTo ErrorHandler

'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item

'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Last, First") And _
(Msg.Subject = "Daily Report") And _
(Msg.Attachments.Count >= 1) Then

' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim XLApp As Object ' Excel.Application
Dim XlWK As Object ' Excel.Workbook
Dim Att As String

'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "G:\Report\TA\"

'Set olDestFldr = objNS.Folders("TA_Reports").Folders
'Set objFolder = myParentFolder.Folders.Item("~Filtered Spam")

' New Excel.Application
Set XLApp = CreateObject("Excel.Application")

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att


' open personal.xls where macro is stored,
' just in case it doesn't open on its own
On Error Resume Next
XLApp.Workbooks.Open _
("C:\Documents and Settings\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error GoTo 0

' open workbook and run macro
XLApp.Workbooks.Open ("C:\Documents and Settings\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")

XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Report\TA\TA.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop


' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"
' Close the database and quit Access
appAccess.CloseCurrentDatabase
appAccess.Quit

' Close the object variable.
Set appAccess = Nothing



' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

I am learning as I go so any help is greatly appreciated!

Thanks for your time,

Regards:

G