Implements IDTExtensibility2
Public WithEvents olInbox As Outlook.Items
Dim WithEvents oApp As Outlook.Application
Dim WithEvents oNS As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
'Dim oCB As Office.CommandBarButton
'Dim oCBs As Office.CommandBars
'Dim oMenuBar As Office.CommandBar
'Dim WithEvents oMyCB As Office.CommandBarButton
'Dim WithEvents oResetCB As Office.CommandBarButton
Public Sub IDTExtensibility2_OnAddInsUpdate( _
custom() As Variant)
' Use this subroutine when Add-ins are updated.
MsgBox "OnAddInsUpdate called"
End Sub
' Use this subroutine when the host app is shutting down.
' You should persist or destroy your objects in this
' subroutine.
Public Sub IDTExtensibility2_OnBeginShutdown( _
custom() As Variant)
MsgBox "OnBeginShutdown called"
On Error Resume Next
Set oApp = Nothing
'Set oCBs = Nothing
'Set oMenuBar = Nothing
'Set oMyCB = Nothing
Set oNS = Nothing
'Set oCB = Nothing
'Set oResetCB = Nothing
Set oFolder = Nothing
End Sub
Private Sub IDTExtensibility2_OnConnection( _
ByVal Application As Object, ByVal ConnectMode As _
AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
' This subroutine is called when your Add-in is connected
' to by the host application.
MsgBox "OnConnection called"
' Get the Application object for Outlook.
Set oApp = Application
' Get the Namespace.
Set oNS = oApp.GetNamespace("MAPI")
If (ConnectMode <> Extensibility.ext_ConnectMode.ext_cm_Startup) Then Call olInbox_ItemAdd(custom)
' Get a Folder to extend with the PropPage extension.
' Let the user pick the folder.
' Set oFolder = oNS.PickFolder()
' Customize the Outlook Menu structure and toolbar.
' Set oCBs = oApp.ActiveExplorer.CommandBars
' Set oMenuBar = oCBs.Add("CustomMenu", , True, True)
' oMenuBar.Visible = True
' Set oMyControl = _
' oMenuBar.Controls.Add(msoControlPopup, , , , True)
' oMyControl.Caption = "&Menu Item"
' Set oResetCB = oMyControl.Controls.Add( _
' Type:=msoControlButton, Temporary:=True, Before:=1)
' oResetCB.Caption = "&Reset Menu"
' oResetCB.Enabled = True
' Set oMyCB = oMyControl.Controls.Add( _
' Type:=msoControlButton, Temporary:=True, Before:=1)
' oMyCB.Caption = "&Test Menu Item"
' oMyCB.Enabled = True
End Sub
Private Sub IDTExtensibility2_OnDisconnection( _
ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, _
custom() As Variant)
' This Sub is called when your add-in is
' disconnected from the host.
MsgBox "OnDisconnection called"
End Sub
Private Sub olInbox_ItemAdd(ByVal Item As Object)
On Error GoTo Err_olInbox_ItemAdd
Dim appAccess As Object 'late binding of the MSAccess object
Dim objDBase As Object 'late binding
MsgBox ("My Item Class is " & Item.Class)
If Item.Class = 43 Then
appAccess = GetObject(, "Access.Application") 'get a database
If TypeName(appAccess) = "Nothing" Then MsgBox ("Failed to get Access")
objDBase = appAccess.CurrentDb
If TypeName(objDBase) = "Nothing" Then MsgBox ("Failed to get current DB")
MsgBox ("objDBase.Name is " & objDBase.Name)
If objDBase.Name = "C:\Console\ConsoleIIIv2.7.7.mdb" Then 'here I check the name of the current database - incase there is more than one open
appAccess.Run ("fromOutlook")
End If
appAccess = Nothing
objDBase = Nothing
End If
Exit_olInbox_ItemAdd:
Exit Sub
Err_olInbox_ItemAdd:
MsgBox(Err.Description & " olInbox_ItemAdd", vbCritical, "Error")
Resume Exit_olInbox_ItemAdd
End Sub
Private Sub Application_Startup()
MsgBox ("Outlook Opening")
olInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Application_Quit()
MsgBox ("Outlook Closing")
olInbox = Nothing
End Sub
