Option Explicit

'Class members
Private WithEvents m_OLApp As Outlook.Application
Private m_OLNameSpace As Outlook.NameSpace

Public Function Logon() As Boolean
'Logon to Outlook
   On Error Resume Next
   'Logon on with default profile
   m_OLNameSpace.Logon
   If Err <> 0 Or _
      UCase$(m_OLNameSpace.CurrentUser) _
      = "UNKNOWN" Then
      Err.Clear
      'ask for prompt
      m_OLNameSpace.Logon , ,True
      If Err <> 0 Then
         Exit Function
      End If
   End If
   Logon = True
End Function

Public Sub Logoff()
'Logoff Outlook
   On Error Resume Next
   m_OLNameSpace.Logoff
End Sub

Public Property Get OutlookApp() As _
   Outlook.Application
'read-only property
   Set OutlookApp = m_OLApp
End Property

Public Property Get NameSpace() As _
   Outlook.NameSpace
'read-only property
   Set NameSpace = m_OLNameSpace
End Property

Private Function ConnectOutlook() As Boolean
'creates references to Outlook

   On Error GoTo ConnectOutlook_Error

   Set m_OLApp = New Outlook.Application
   Set m_OLNameSpace = _
      m_OLApp.GetNamespace("MAPI")
   ConnectOutlook = True
   Exit Function

ConnectOutlook_Error:
   Set m_OLNameSpace = Nothing
   Set m_OLApp = Nothing
End Function

Private Sub DisconnectOutlook()
'disconnects open Outlook objects

   On Error Resume Next
   If Not m_OLNameSpace Is Nothing _
      Then m_OLNameSpace.Logoff
   If Not m_OLNameSpace Is Nothing _
      Then Set m_OLNameSpace = Nothing
   If Not m_OLApp Is Nothing _
      Then Set m_OLApp = Nothing

End Sub

Private Sub Class_Initialize()
   If Not ConnectOutlook() Then
      MsgBox "Error connecting to Outlook"
   End If
End Sub

Private Sub Class_Terminate()
   DisconnectOutlook
End Sub