I am developing a VB app that stores contact
information.  Included in this is the email
address of the contact.

I would like to have a button that the user can
push that would launch his email program with the
recipient address filled in for them.

I would like to accomplish this in a generic way
(i.e. not specific to outlook or anything like
that).  Kinda like the "mailto" function in html.

Any ideas?

Thanks,

Public Function Send_EMail(Subject As String, _
                           msg As String, _
                           SendTo As String, _
                           Optional Attachment As String = "") As Boolean

'------------------------------------
Dim objOut As New OUTLOOK.Application
Dim objMail As Object
'------------------------------------

On Error GoTo errhandler

Screen.Mousepointer = vbHourGlass

Set objMail = objOut.CreateItem(olMailItem)

With objMail
   .Recipients.Add (SendTo)
   .Subject = Subject
   .Body = msg
   If (Attachment <> "") Then
      If (Dir(Attachment) <> "") Then
         .Attachments.Add (Attachment)
      Else
         Screen.Mousepointer = vbNormal
         MsgBox "Invalid file path for email attachment!"
         Set objOut = Nothing
         Set objMail = Nothing
         Exit Function
      End If
   End If
   .Send 'this command will send it
End With

Set objOut = Nothing
Set objMail = Nothing

Send_EMail = True

Screen.Mousepointer = vbNormal

Exit Function
errhandler:
Screen.Mousepointer = vbNormal
MsgBox "Error in Send_mail: " & Err.Description, vbCritical

End Function

' Declarations for Windows API calls
Private Declare Function ShellExecute _
  Lib "shell32.dll" _
  Alias "ShellExecuteA" _
  (ByVal hwnd As Long, _
   ByVal lpOperation As String, _
   ByVal lpFile As String, _
   ByVal lpParameters As String, _
   ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) _
  As Long

Private Declare Sub ShellExecuteEx _
  Lib "shell32.dll" _
  Alias "ShellExecuteExA" _
  (lpExecInfo As SHELLEXECUTEINFO)

Private Declare Function GetExitCodeProcess _
  Lib "kernel32" _
  (ByVal hProcess As Long, _
  lpExitCode As Long) _
  As Long

Private Declare Function OpenProcess _
  Lib "kernel32" _
  (ByVal dwDesiredAccess As Long, _
   ByVal bInheritHandle As Long, _
   ByVal dwProcessId As Long) _
  As Long

Private Type SHELLEXECUTEINFO
  cbSize As Long
  fMask As Long
  hwnd As Long
  lpVerb As String
  lpFile As String
  lpParameters As String
  lpDirectory As String
  nShow As Long
  hInstApp As Long
  '  Optional fields
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type

Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_DOENVSUBST = &H200

' Public property enumerated constants
Public Enum EnumShellExecuteErrors
  seeNoError = -1                 'Any value above 32
  seeOUT_OF_MEMORY = 0            'The operating system is out of
memory or resources.
  seeERROR_FILE_NOT_FOUND = 2     'The specified file was not found.
  seeERROR_PATH_NOT_FOUND = 3     'The specified path was not found.
  seeERROR_BAD_FORMAT = 11        'The .exe file is invalid
(non-Win32? .exe or error in .exe image).
  seeSE_ERR_ACCESSDENIED = 5      'The operating system denied access
to the specified file.
  seeSE_ERR_ASSOCINCOMPLETE = 27  'The file name association is
incomplete or invalid.
  seeSE_ERR_DDEBUSY = 30          'The DDE transaction could not be
completed because other DDE transactions were being processed.
  seeSE_ERR_DDEFAIL = 29          'The DDE transaction failed.
  seeSE_ERR_DDETIMEOUT = 28       'The DDE transaction could not be
completed because the request timed out.
  seeSE_ERR_DLLNOTFOUND = 32      'The specified dynamic-link library
was not found.
  seeSE_ERR_NOASSOC = 31          'There is no application associated
with the given file name extension.
  seeSE_ERR_OOM = 8               'There was not enough memory to
complete the operation.
  seeSE_ERR_SHARE = 26            'A sharing violation occurred.

End Enum

Public Enum EnumShellExecuteShowStyles
  sesSW_HIDE = 0
  sesSW_MAXIMIZE = 3
  sesSW_MINIMIZE = 6
  sesSW_RESTORE = 9
  sesSW_SHOW = 5
  sesSW_SHOWDEFAULT = 10
  sesSW_SHOWMAXIMIZED = 3
  sesSW_SHOWMINIMIZED = 2
  sesSW_SHOWMINNOACTIVE = 7
  sesSW_SHOWNA = 8
  sesSW_SHOWNOACTIVATE = 4
  sesSW_SHOWNORMAL = 1
End Enum

Private mlnghInstance As Long
Private mlnghProcess As Long

Public Function LaunchEmail( _
  lnghWnd As Long, _
  strAddress As String, _
  Optional eShowStyle As EnumShellExecuteShowStyles =
sesSW_SHOWDEFAULT) _
  As EnumShellExecuteErrors
  ' Comments  : Open the program associated with email on the system.
  ' Parameters: lnghWnd - Handle to window of a form

  '             eShowStyle - Constant indicating how the browser
  '             is to be displayed (maximized, minimized etc.)
  ' Returns   : -1 on Success, or one of the values in the
  '             EnumShellExecuteErrors constants on failure
  '
  Dim lngResult As Long
  Dim strTmp As String

  On Error GoTo PROC_ERR

  mlnghInstance = 0
  mlnghProcess = 0

  strTmp = "mailto:" & strAddress

  lngResult = ShellExecute( _
    lnghWnd, _
    vbNullString, _
    strTmp, _
    vbNullString, _
    vbNullString, _
    eShowStyle)

  If lngResult > 32 Then
    LaunchEmail = seeNoError
  Else
    LaunchEmail = lngResult
  End If

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "LaunchEmail"
  Resume PROC_EXIT

End Function

'-------------------------------------------------------------
this is a code example

Public Sub CmdEmail_Click()
  Dim ShellExecute As CShellExecute
  Dim lngResult As EnumShellExecuteErrors

  Set ShellExecute = New CShellExecute

  ' Example code for LaunchEmail
  lngResult = ShellExecute.LaunchEmail( _
     Me.hwnd, _

  If lngResult <> seeNoError Then
    MsgBox "Error on LaunchEmail: " & lngResult
  End If

End Sub

On Wed, 17 Jan 2001 07:43:16 +1000, "Harry Strybos"