Option Explicit

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 Const SW_SHOWNORMAL = 1
Private Const mcCrLf = "%0D%0A"

Private Sub cmdShowEmail_Click()
  Dim strTemp  As String
  Dim strEMail As String

  strEMail = vbNullString

 'E-Mail-Empfänger
  strTemp = Trim$(Me.txtEmailTo.Text)
  If Len(strTemp) = 0 Then
    MsgBox "Bitte geben Sie die E-Mail-Adresse des " & _
           "Empfängers ein!", vbOKOnly + vbInformation, _
           Title:=Me.Caption
    txtEmailTo.SetFocus
    Exit Sub
  Else
    strEMail = strEMail & "mailto:" & strTemp
  End If

 'E-Mail-Betreff
  strTemp = Trim$(Me.txtSubject.Text)
  If Len(strTemp) <> 0 Then
    strEMail = strEMail & "?Subject=" & strTemp
  End If

 'E-Mail-Text
  strTemp = Me.txtBody.Text
  If Len(Trim$(strTemp)) <> 0 Then
    strTemp = VBA.Replace(strTemp, vbCrLf, mcCrLf)
    strEMail = strEMail & "&body=" & strTemp
  End If

 'E-Mail-Anhang
  strTemp = Me.txtAttachment.Text
  If Len(Trim$(strTemp)) > 0 Then
    If FileExists(strTemp) Then
      strTemp = Chr$(34) & strTemp & Chr$(34)
      strEMail = strEMail & "&Attachment=" & strTemp
    End If
  End If

 'E-Mail anzeigen
  ShellExecute Me.hwnd, "Open", strEMail, vbNullString, _
        vbNullString, SW_SHOWNORMAL
End Sub

Private Function FileExists(strFile As String) As Boolean
  On Error Resume Next
  FileExists = Dir$(strFile) <> ""
  FileExists = FileExists And Err = 0
  On Error GoTo 0
End Function