HOWTO: Logging on to Active Messaging Session w/ Default Profile

ID: Q171422


The information in this article applies to:
  • Collaboration Data Objects (CDO), versions 1.1, 1.21
  • Microsoft Visual Basic Learning, Professional, and Enterprise Editions for Windows, version 5.0
  • Microsoft Visual Basic Standard, Professional, and Enterprise Editions, 32-bit only, for Windows, version 4.0


SUMMARY

In order to send mail via Active Messaging, you need to establish and logon to a session. Logging onto a session requires that you provide a profile name. If you do not programmatically provide a profile you receive a dialog box asking the user to choose a profile.

This article describes how to logon to an Active Messaging session by using the default profile of the current user.


MORE INFORMATION

There are two ways to logon to an Active Messaging session using the current user's default profile:

  1. If the user has a session running (for example, they have an Outlook client running), executing the following line of code will use the already instantiated session using the profile they are currently logged on with:
    
          objSession.Logon ShowDialog:=False, NewSession:=False 
    Where "objSession" has been created as a MAPI.Session.


  2. If the user does not have a session running, you need to find the default profile in the registry.


Since finding the default profile in the registry requires a lot of code, it makes sense to attempt to logon assuming that the user has a session running. If the user does not have a session running, a trappable error results. You can place the code for finding the default profile in the error handler.
  1. Start a new Standard EXE Visual Basic Project.


  2. Add a module.


  3. Add a reference to the "Microsoft Active Messaging 1.1 Object Library" (Olemsg32.dll).


  4. Copy and paste the following code to the General Declaration section of your form:
    
          Private Sub Form_Load()
             Dim objOutBox As Folder
             Dim objNewMessage As Message
             Dim objRecipients As Recipients
             Dim objOneRecip As Recipient
    
             StartMessagingAndLogon
             Set objOutBox = objSession.Outbox
             Set objNewMessage = objOutBox.Messages.Add
             Set objRecipients = objNewMessage.Recipients
             Set objOneRecip = objRecipients.Add
             With objOneRecip
                'Fill in an appropriate alias here
                .Name = "MyName"
                .Type = ActMsgTo
                .Resolve ' get MAPI to determine complete e-mail address
             End With
             With objNewMessage
                .Subject = "Test Active Messaging"
                .Text = "Text of Active Messaging text"
                .Send
             End With
          End Sub
    
          Sub StartMessagingAndLogon()
             Dim sKeyName As String
             Dim sValueName As String
             Dim sDefaultUserProfile As String
             Dim osinfo As OSVERSIONINFO
             Dim retvalue As Integer
    
             On Error GoTo ErrorHandler
             Set objSession = CreateObject("MAPI.Session")
    
             'Try to logon.  If this fails, the most likely reason is
             'that you do not have an open session.  The error
             '-2147221231  MAPI_E_LOGON_FAILED will return.  Trap
             'the error in the ErrorHandler
             objSession.Logon ShowDialog:=False, NewSession:=False
             Exit Sub
          ErrorHandler:
             Select Case Err.Number
                Case -2147221231  'MAPI_E_LOGON_FAILED
                   'Need to find out what OS is in use, the keys are different
                   'for WinNT and Win95.
                   osinfo.dwOSVersionInfoSize = 148
                   osinfo.szCSDVersion = Space$(128)
                   retvalue = GetVersionEx(osinfo)
                   Select Case osinfo.dwPlatformId
                      Case 0   'Unidentified
                         MsgBox "Unidentified Operating System.  " & _
                            "Can't log onto messaging."
                         Exit Sub
                      Case 1   'Win95
                         sKeyName = "Software\Microsoft\" & _
                                    "Windows Messaging " & _
                                    "Subsystem\Profiles"
    
                      Case 2   'NT
                          sKeyName = "Software\Microsoft\Windows NT\" & _
                                     "CurrentVersion\" & _
                                     "Windows Messaging Subsystem\Profiles"
                   End Select
    
                   sValueName = "DefaultProfile"
                   sDefaultUserProfile = QueryValue(sKeyName, sValueName)
                   objSession.Logon ProfileName:=sDefaultUserProfile, _
                                    ShowDialog:=False
                   Exit Sub
                Case Else
                   MsgBox "An error has occured while attempting" & Chr(10) & _
                   "To create and logon to a new ActiveMessage session." & _
                   Chr(10) & "Please report the following error to your " & _
                   "System Administrator." &  Chr(10) & Chr(10) & _
                   "Error Location: frmMain.StartMessagingAndLogon" & _
                   Chr(10) & "Error Number: " & Err.Number & Chr(10) & _
                   "Description: " & Err.Description
             End Select
          End Sub 


  5. Copy and paste the following code to your Module:
    
          Public objSession As MAPI.Session
          Public objNewMessage As Message
    
          Public Type OSVERSIONINFO
             dwOSVersionInfoSize As Long
             dwMajorVersion As Long
             dwMinorVersion As Long
             dwBuildNumber As Long
             dwPlatformId As Long
             szCSDVersion As String * 128
          End Type
    
          Global Const REG_SZ As Long = 1
          Global Const REG_DWORD As Long = 4
          Global Const HKEY_CURRENT_USER = &H80000001
          Global Const ERROR_NONE = 0
          Global Const ERROR_BADDB = 1
          Global Const ERROR_BADKEY = 2
          Global Const ERROR_CANTOPEN = 3
          Global Const ERROR_CANTREAD = 4
          Global Const ERROR_CANTWRITE = 5
          Global Const ERROR_OUTOFMEMORY = 6
          Global Const ERROR_INVALID_PARAMETER = 7
          Global Const ERROR_ACCESS_DENIED = 8
          Global Const ERROR_INVALID_PARAMETERS = 87
          Global Const ERROR_NO_MORE_ITEMS = 259
    
          Global Const KEY_ALL_ACCESS = &H3F
    
          Global Const REG_OPTION_NON_VOLATILE = 0
    
          Declare Function GetVersionEx Lib "kernel32" _
             Alias "GetVersionExA" _
                   (ByRef lpVersionInformation As OSVERSIONINFO) As Long
    
    
          Public Declare Function RegCloseKey Lib "advapi32.dll" _
                   (ByVal hKey As Long) As Long
    
          Public Declare Function RegOpenKeyEx Lib "advapi32.dll" _
             Alias "RegOpenKeyExA" _
                   (ByVal hKey As Long, _
                   ByVal lpSubKey As String, _
                   ByVal ulOptions As Long, _
                   ByVal samDesired As Long, _
                   phkResult As Long) As Long
    
          Public Declare Function RegQueryValueExString Lib "advapi32.dll" _
             Alias "RegQueryValueExA" _
                   (ByVal hKey As Long, _
                   ByVal lpValueName As String, _
                   ByVal lpReserved As Long, _
                   lpType As Long, _
                   ByVal lpData As String, _
                   lpcbData As Long) As Long
    
          Public Declare Function RegQueryValueExLong Lib "advapi32.dll" _
             Alias "RegQueryValueExA" _
                   (ByVal hKey As Long, _
                   ByVal lpValueName As String, _
                   ByVal lpReserved As Long, _
                   lpType As Long, lpData As Long, _
                   lpcbData As Long) As Long
    
          Public Declare Function RegQueryValueExNULL Lib "advapi32.dll" _
             Alias "RegQueryValueExA" _
                   (ByVal hKey As Long, _
                   ByVal lpValueName As String, _
                   ByVal lpReserved As Long, _
                   lpType As Long, _
                   ByVal lpData As Long, _
                   lpcbData As Long) As Long
    
    
          Public Function QueryValue _
                   (sKeyName As String, _
                   sValueName As String)
    
          Dim lRetVal As Long     'result of the API functions
          Dim hKey As Long        'handle of opened key
          Dim vValue As Variant   'setting of queried value
    
          lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, _
                               sKeyName, _
                               0, _
                               KEY_ALL_ACCESS, _
                               hKey)
    
          lRetVal = QueryValueEx(hKey, _
                               sValueName, _
                               vValue)
          QueryValue = vValue
          RegCloseKey (hKey)
    
          End Function
          Function QueryValueEx _
                (ByVal lhKey As Long, _
                ByVal szValueName As String, _
                vValue As Variant) As Long
    
             Dim cch As Long
             Dim lrc As Long
             Dim lType As Long
             Dim lValue As Long
             Dim sValue As String
    
             On Error GoTo QueryValueExError
    
             ' Determine the size and type of data to be read
             lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
             If lrc <> ERROR_NONE Then Error 5
    
             Select Case lType
                ' For strings
                Case REG_SZ:
                   sValue = String(cch, 0)
                   lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
                      sValue, cch)
                   If lrc = ERROR_NONE Then
                      vValue = Left$(sValue, cch)
                   Else
                      vValue = Empty
                   End If
                ' For DWORDS
                Case REG_DWORD:
                   lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
                      lValue, cch)
                   If lrc = ERROR_NONE Then vValue = lValue
                Case Else
                   'all other data types not supported
                   lrc = -1
             End Select
    
          QueryValueExExit:
             QueryValueEx = lrc
             Exit Function
          QueryValueExError:
             Resume QueryValueExExit
          End Function 


  6. Run the project. You will send mail to the "Recipient" that you entered in Form_Load.



REFERENCES

For additional information on how to obtain the Active Messaging Library, please see the following article in the Microsoft Knowledge Base:

Q171440 Where to Acquire the Collaboration Data Objects Libraries
For additional information about Collaboration Data Objects versus Active Messaging, please see the following article in the Microsoft Knowledge Base:
Q176916 INFO: Active Messaging and Collaboration Data Objects (CDO)

Additional query words:

Keywords : kbActMsg kbCDO110 kbCDO121 kbVBp400 kbVBp500 kbfaq
Version : WINDOWS:1.1,1.21,4.0,5.0
Platform : WINDOWS
Issue type : kbhowto


Last Reviewed: December 2, 1999
© 2000 Microsoft Corporation. All rights reserved. Terms of Use.