Private Sub cmdMail_versenden_Click()
'Email an Kontakt senden
'leicht abgewandelte Kopie aus der MS Auto97.hlp
 
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
  'Variablen für die Übergabe
    Dim Empf        As String   'An:
    Dim CC          As String   'CC:
    Dim BCC         As String   'BCC:
    Dim Betreff     As String
    Dim Nachricht   As String
    Dim ATT     'Dateipfad zum Attachment
    Dim olVorlage As String
    Dim rec As Recordset
    Dim I As Long, Q As Long
    
    
10       On Error GoTo Ansicht_Serienbrief_EMail_Click_Error
 
20      If IsNull(txtBetreff) Then
30          MsgBox "Bitte unbedingt den Betreff ausfüllen!", vbCritical
40          Exit Sub
50      End If
  
        Empf = "toVorname.Nachname@domain.de"
        
100   Betreff = txtBetreff
110   If Betreff = "" Then Exit Sub
    
    ' Create the Outlook session.
160       Set objOutlook = CreateObject("Outlook.Application")
 
    ' Create the message.
170       Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
 
    
180       With objOutlookMsg
   
   ' Add the To recipient(s) to the message.
190      Set objOutlookRecip = Empf
         objOutlookRecip.Type = olTo
  
  ' Set the Subject, Body, and Importance of the message.
210     .Subject = Betreff
        .Body = Nachricht      'Nur Text
220     '.HTMLBody = Me.WBrowser.Object.Document.body.innerHTML
 
  '.Categories = "Test"
  'Abstimmungs-Schaltflächen
  '.VotingOptions = "Stimme zu!;Lehne ab!; Ist mir Wurscht!"
  
  
  
230     .Importance = olImportanceHigh  'Dringlichkeit: Hoch
  
  
  ' Ein Attachment zur Mail hinzufügen.
  '====================================
'   If ATT  "" Then
'          Set objOutlookAttach = .Attachments.Add(ATT)
'   End If
          
   'Wenn mehrere Attachment's zur Mail hinzufügen.
   '==============================================
          
240       For Q = 0 To cmbAnlagen.ListCount - 1
250        Set objOutlookAttach = .Attachments.Add(cmbAnlagen.ItemData(Q))
260       Next
 
265    .Display 
270     '.Send   'sofortiger Versand
 
    
280       End With
    
310       Set objOutlook = Nothing
 
320      On Error GoTo 0
330      Exit Sub
 
Ansicht_Serienbrief_EMail_Click_Error:
 
340   Select Case Err.Number
      Case 52
350       MsgBox "Datei nicht gefunden !"
360       Exit Sub
370   Case 9
380      Exit Sub
390   Case 99
400      Exit Sub 'Wenn Abbrechen gewählt wurde im Dateiauswahldialog
410   Case Else
420           MsgBox "Fehlernr.: " & Err.Number & " (" & Err.Description & ") in Prozedur cmdMail_versenden von Modul Funktionen", , "Fehler in Zeile: " & Erl
430   End Select
 
End Sub