-
Ok if I'm clear if it meets the conditions for the first email/subject combo you want it to do everything.
If it meets the conditions of the second and third combinations you want it to download the attachment but do nothing else?
if so then this should work
[VBA]Private WithEvents Items As Outlook.Items
Option Explicit
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)
Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim myAttachments As Attachments
Dim XLApp As Object ' Excel.Application
Dim appAccess As Object ' Access.Application
Dim XlWK As Object ' Excel.Workbook
Dim boolDownload As Boolean
boolDownload = False
On Error Goto ErrorHandler
'Only act if it's a MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
If Msg.Sender = "Doe, Jane" And Msg.Subject = "Test1" Then
attPath = "G:\Daily\TA\"
boolDownload = True
myAttachments.Item(1).SaveAsFile attPath & Att
ElseIf Msg.SenderEmailAddress = "someone@gmail.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily\TA\"
myAttachments.Item(1).SaveAsFile attPath & Att
ElseIf Msg.Sender = "Doe, John" And Msg.Subject = "Test3" Then
attPath = "G:\Daily\TA\"
myAttachments.Item(1).SaveAsFile attPath & Att
End If
If boolDownload = True Then
' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder
' New Excel.Application
Set XLApp = CreateObject("Excel.Application")
' open personal.xls where macro is stored, and run macro
On Error Resume Next
XLApp.Workbooks.Open ("C:\Documents and Settings\gregory.l.young\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error Goto 0
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:\Daily\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 [/VBA]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules