-
[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 myItem As Outlook.MailItem
Dim strAttPath As String
Dim strAtt As String
Dim strFullPath As String
Dim myAttachments As Attachments
Dim myAtt As Attachment
Dim olDestFldr As Outlook.MAPIFolder
On Error GoTo ErrorHandler
'Only act if it's a MailItem
If TypeName(Item) = "MailItem" Then
Set myItem = Item
Set myAttachments = Item.Attachments
Set myAtt = myAttachments.Item(1)
strAtt = myAtt.DisplayName
strFullPath = strAttPath & strAtt
If (myItem.SenderEmailAddress = "someone@ltr.com" Or myItem.Sender = "someone@ltr.com") And myItem.Subject = "Test1" Then
strAttPath = "G:\Daily \Test\TT Report\"
myAtt.SaveAsFile strFullPath
Call xlAcsub(strFullPath)
myItem.UnRead = False
'myItem.Move olDestFldr
ElseIf (myItem.SenderEmailAddress = "someoneelse@ltr.com" Or myItem.Sender = "someoneelse@ltr.com") And myItem.Subject = "Test2" Then
strAttPath = "G:\Daily \Test\UMTA Report\"
myAtt.SaveAsFile strFullPath
'Call anothersub
myItem.UnRead = False
'myItem.Move olDestFldr
ElseIf (myItem.SenderEmailAddress = "email@gmail.com" Or myItem.Sender = "email@gmail.com") And myItem.Subject = "test1" Then
strAttPath = "C:\Users\Brian\Desktop\"
myAtt.SaveAsFile strFullPath
'Call stillanothersub
myItem.UnRead = False
'myItem.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Sub xlAcsub(strToKill As String)
On Error GoTo ErrorHandler
Dim XLApp As Object ' Excel.Application
Dim appAccess As Object ' Access.Application
Dim XlWK As Object ' Excel.Workbook
Dim tim As Long
Set XLApp = CreateObject("Excel.Application")
Set appAccess = CreateObject("Access.Application")
XLApp.Workbooks.Open ("C:\Documents and Settings\gregory.l.young\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill strToKill
XLApp.Quit
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop
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
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
[/vba]
This should be more like what your looking for. Personally I would add references to excel and access and code it all in outlook instead of calling the functions in those applications but thats just my personal preference. I left quite a bit of your commented out code in because I wasn't sure what you were wanting to uncomment in the future.
Hope that clears it up a bit. I would also suggest you do some reading about vba functions and passing variables. Once you understand this it will really help your coding. Another helpful bit is to learn to assign object variables instead of using references to them.
ie
[vba]
sub openandcloseworkbook
dim wbToOpen as workbook
set wbToOpen = workbooks.open("C:\workbook.xls")
wbToOpen.close false
end sub
[/vba]
instead of
[vba]
sub openandcloseworkbook
workbooks.open("C:\workbook.xls")
workbooks("workbook.xls").close false
end sub
[/vba]
when you define objects as what they are when you type wbToOpen. <
you will get a dropdown of all the options you have to work with this object.
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