Registrations are now open. Join us today!
There is still a lot of work to do on the wiki yet! More information about editing can be found here.
Already have an account?

Microsoft KB Archive/171422

From BetaArchive Wiki
Knowledge Base


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:

  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)


Keywords: kbhowto kbmsg kbfaq KB171422