How to use CDO 1.21 to log on to a MAPI session by using the default profile of the current user (171422)


The information in this article applies to:

  • Collaboration Data Objects (CDO) 1.21
This article was previously published under Q171422

SUMMARY

In order to send mail using CDO (1.x), 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 a CDO (1.1, 1.2, 1.21) session by using the default profile of the current user.

MORE INFORMATION

There are two ways to logon to a CDO (1.1, 1.2, 1.21) 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 hook 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 fair amount of code, it makes sense to attempt to logon assuming that the user has a session running. Then, if the user did not have a session running, a trappable error results. You can then 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 CDO library installed on your system. The file will be Olemsg32.dll, or CDO.DLL, and be either version 1.1, 1.2, or 1.21.
  4. Copy and paste the following code to the General Declaration section of your Form (not Module):
          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 = CdoTo
            .Resolve ' get MAPI to determine complete e-mail address
         End With
         With objNewMessage
            .Subject = "Test CDO Message"
            .Text = "Text of CDO Message"
            .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 it fails, the most likely reason is that you do
         'not have an open session.  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 CDO (1.x) 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 (not Form):
          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 more information about how to obtain the CDO (1.x) Libraries, click the following article number to view the article in the Microsoft Knowledge Base:

171440 Where to acquire the CDO Libraries (all versions)

Modification Type:MajorLast Reviewed:9/8/2005
Keywords:kbFAQ kbhowto kbMsg KB171422
©2004 Microsoft Corporation. All rights reserved.