Email aus Outlook

Private Sub cmbSave_Click()
Dim sucheintrag
Dim n As Long
Dim tabelleneintrag As String
Dim zelle As String
Dim änderungseintrag1
Dim änderungseintrag2
Dim toneranzahl As Long
Dim tonerminimum As Long
Dim OutApp As Object, mail As Object, i
Dim nachricht
Dim clpobj As DataObject
Dim emailzusatz As String
Dim emailzusatz2 As String
'change the table entry by display and save to the table
sucheintrag = lstCartridgeDisplay.Value
n = 4
Do
n = n + 1
zelle = "A" & n
tabelleneintrag = ActiveWorkbook.Worksheets("Tonerverwaltung").Range("A" & n).Value
If sucheintrag = tabelleneintrag Then
änderungseintrag1 = txtCartridgeCounter.Value
änderungseintrag2 = txtCartridgeMinimum.Value
Worksheets("Tonerverwaltung").Range("B" & n).Value = änderungseintrag1
Worksheets("Tonerverwaltung").Range("C" & n).Value = änderungseintrag2
Exit Do
End If
Loop
'if "toneranzahl" <= tonerminimum then msgbox/email warning
toneranzahl = txtCartridgeCounter.Value
tonerminimum = txtCartridgeMinimum.Value
Do
If toneranzahl <= tonerminimum Then
MsgBox ("Bitte bestellen Sie den entsprechenden Toner nach!"), , ("Tonerbestand kritisch!")
For i = 1 To 1
Set clpobj = New DataObject
Set OutApp = CreateObject("Outlook.Application")
Set nachricht = OutApp.Createitem(0)
'Range of Table Cartridge which should be sent
Worksheets("Tonerverwaltung").Activate
emailzusatz = "Bitte folgenden Toner nachbestellen (Anzahl/Mindestbestand)"
emailzusatz2 = "-------------------------------------------------------------------------------------------"
ActiveWorkbook.Worksheets("Tonerverwaltung").Range("A" & n & ":C" & n).Select
'copy of selcted table entry to clipboard
Selection.Copy
With nachricht
.Subject = "Tonerbestand kritisch!"
'paste of table erntry
clpobj.GetFromClipboard
.Body = emailzusatz & vbCrLf & emailzusatz2 & vbCrLf & clpobj.GetText(1)
.To = "xxxx@xx.de"
Application.DisplayAlerts = False
'display email
'Paste email to email out
.send
Application.DisplayAlerts = True
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Tonerverwaltung").Range("A5").Select
End With
Set OutApp = Nothing
Set nachricht = Nothing
'Waiting for Outlook
Application.Wait (Now + TimeValue("0:00:05"))
Next i
Exit Do
End If
If Not toneranzahl <= tonerminimum Then
Exit Do
End If
Loop
MsgBox ("Änderung gespeichert!")
ActiveWorkbook.Save
End Sub