Outlook email to Access

[New2VB]

Greetings Gurus,

Could you please help?

I have some vba running in a ThisOutlookSession.OTM

Private Sub olInbox_ItemAdd(ByVal Item As Object)
On Error GoTo Err_olInbox_ItemAdd

    Dim appAccess As Object
    Dim objDBase As Object
     
If Item.Class = 43 Then 'tried Or Item.Class = 45 in case this was the cause, but it's not
    Set appAccess = GetObject(, "Access.Application") 'get a database
If TypeName(appAccess) = "Nothing" Then MsgBox "Failed to get Access"
    Set objDBase = appAccess.CurrentDb
If TypeName(objDBase) = "Nothing" Then MsgBox "Failed to get current DB"
If objDBase.Name = "C:\mymdb.mdb" Then
    appAccess.Run "fromOutlook", Item
End If

Set appAccess = Nothing
Set objDBase = Nothing

End If
 
End Sub

Private Sub Application_Startup()
Set oNS = Application.GetNamespace("MAPI")
Set olInbox = oNS.GetDefaultFolder(olFolderInbox).Items

this calls the following

Dim db As Database, tb As DAO.Recordset
Set db = CurrentDb
Set tb = db.OpenRecordset("dbo_table", dbOpenDynaset, dbSeeChanges)
        tb.AddNew
         ' add some stuff
    tb.Update
   tb.Close
db.Close

and this all works fine. However I know have a need to pull new mail from a public folder as well. Assuming you can do this, and I haven't seen anywhere saying you can't, I amended the code to

Set oNS = Application.GetNamespace("MAPI")
Set olInbox = oNS.GetDefaultFolder(olFolderInbox).Items
Set pf = oNS.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set swpf = pf.Folders("Swall")
Set swMail = swpf.Items

but this doesn't work.

I am not sure that this is the "proper" way to do this but all the examples I have found involve taking the mail out of "Default" outlook folders from Access, not passing the new mail to Access.

Would greatly appreciate your ideas. Thanks.

 

[New2VB]

It seems that each iteration needs to run in its own sub, i.e you need one for "Private Sub olInbox_ItemAdd(ByVal Item As Object)" and another one for "Private Sub olPublicFolderName_ItemAdd(ByVal Item As Object) but at least its working now.