Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal hKey As Long _
) As Long
Private Declare Function RegOpenKeyEx _
Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
ByRef phkResult As Long _
) As Long
Private Declare Function RegQueryValueEx _
Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByRef lpData As Any, _
ByRef lpcbData As Long _
) As Long
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const REG_SZ As Long = 1
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SYNCHRONIZE = &H100000
Private Const ERROR_SUCCESS As Long = 0&
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS _
Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Function DefaultMail() As String
Dim hKey As Long
Dim sRetVal As String
Const MAX_PATH = 260&
If RegOpenKeyEx(HKEY_CLASSES_ROOT, "\mailto\shell\open\command\", _
0, KEY_ALL_ACCESS, hKey) = ERROR_SUCCESS Then
sRetVal = String(MAX_PATH + 1, vbNullChar)
If RegQueryValueEx(hKey, vbNullString, 0&, REG_SZ, _
ByVal sRetVal, MAX_PATH + 1) = ERROR_SUCCESS Then
DefaultMail = Left$(sRetVal, InStr(sRetVal, vbNullChar) - 1)
End If
Call RegCloseKey(hKey)
End If
End Function