ID: Q171422
The information in this article applies to:
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.
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.
default profile in the registry.
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).
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
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
entered in Form_Load.
For additional information on how to obtain the Active Messaging Library, please see the following article in the Microsoft Knowledge Base:
ARTICLE-ID: Q171440
TITLE : Where to Acquire the Collaboration Data Objects Libraries
ARTICLE-ID: Q176916
TITLE : INFO: Active Messaging and Collaboration Data Objects (CDO)
Keywords : kbActMsg kbCDO110 kbCDO121 kbVBp400 kbVBp500
Version : WINDOWS:1.1,4.0,5.0,1.21
Platform : WINDOWS
Issue type : kbhowtoLast Reviewed: April 8, 1999