Microsoft KB Archive/171422: Difference between revisions
m (Text replacement - "<" to "<") |
m (Text replacement - ">" to ">") |
||
Line 257: | Line 257: | ||
' Determine the size and type of data to be read | ' Determine the size and type of data to be read | ||
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) | lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) | ||
If lrc < | If lrc <> ERROR_NONE Then Error 5 | ||
Select Case lType | Select Case lType |
Revision as of 20:43, 20 July 2020
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
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
- 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