Option Explicit

Function GetDefaultMapiProfile()
	Dim Shell
	Set Shell = WScript.CreateObject("WScript.Shell")

	Dim RegKey9x, RegKeyNT
	RegKey9x = _
		"HKCU\Software\Microsoft\Windows Messaging Subsystem\" & _
		"Profiles\DefaultProfile"
	RegKeyNT = _
		"HKCU\Software\Microsoft\Windows NT\CurrentVersion\" & _
		"Windows Messaging Subsystem\Profiles\DefaultProfile"
	
	On Error Resume Next
	Err.Clear
	GetDefaultMapiProfile = Shell.RegRead(RegKey9x)
	If Err.Number <> 0 Then 
		Err.Clear
		GetDefaultMapiProfile = Shell.RegRead(RegKeyNT)
		If Err.Number <> 0 Then GetDefaultMapiProfile = ""
	End If
	
	Set Shell = Nothing
End Function

MsgBox GetDefaultMapiProfile