Microsoft KB Archive/171422

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

Article ID: 171422

Article Last Modified on 9/8/2005

-

APPLIES TO


 * Microsoft Collaboration Data Objects 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:   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.  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.  Start a new Standard EXE Visual Basic Project. Add a module. 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.  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 </li>  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 </li> Run the project. You will send mail to the "Recipient" that you entered in Form_Load.</li></ol>

<div class="references_section">