Verstehe immer noch nicht so recht
16.06.2014 11:23:46
Rudi
Hallo Frank,
was gibt es da nicht zu verstehen?
Ich habe dir geantwortet und dir den Code geschickt.
Nepumuk hat mir eine Anregung zur Verbesserung gegeben.
Zu deiner Frage.
In DieseArbeitsmappe:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
StartMail
End Sub
In ein Modul:
Sub StartMail()
Dim strTo As String, strSUBJECT As String, strText As String, _
strCC As String, strBCC As String, strAtt As String, _
strToner As String
strToner = FehlBestand
strTo = "jemand@irgendwo.com" 'mehrere mit ; trennen
strSUBJECT = "Fehlender Toner"
strText = "Bitte Toner " & strToner & " bestellen."
SendMail_Outlook strTo, strSUBJECT, strText, strCC, strBCC, strAtt
End Sub
Sub SendMail_Outlook(strTo As String, strSUBJECT As String, strText As String, _
strCC As String, strBCC As String, strAtt As String)
Dim MyMessage As Object, MyOutApp As Object, i As Integer
'Outlook Object erstellen
Set MyOutApp = CreateObject("Outlook.Application")
'Outlook Nachricht erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Empfänger
.To = strTo
'Kopie
.CC = strCC
'Blindkopie
.BCC = strBCC
'Betreff
.Subject = strSUBJECT
For i = 0 To UBound(Split(strAtt, ";"))
.Attachments.Add Trim(Split(strAtt, ";")(i))
Next
'Hier wird ein normaler Text erstellt
.Body = strText
'Hier wird eine HTML Mail erstellt
'Dies kann zu Problemen führen, wenn der Empfänger nur TEXT Dateien empfangen darf.
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
' .Display
'Hier wird die Mail gleich in den Postausgang gelegt und gesendet
.Send
End With
'Outlook schliessen
'MyOutApp.Quit
'Variablen leeren
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Function FehlBestand() As String
Dim rngC As Range
With Sheets("Tonerbestand")
For Each rngC In .Range(.Cells(2, 5), .Cells(45, 5))
If rngC
Gruß
Rudi