E-Mail automatisch anstoßen via VBA
05.01.2020 22:04:09
Daniel
und schon wieder stehe ich mit Excel im Krieg.
Der unten stehende Code ist FAST so wie ich ihn benötige, ABER nur fast.
In der Spalte O3:O45 stehen Werte basierend auf meiner Datumsberechnung.
Jetzt soll ab den Wert 14 bis -200 gesucht werden und aus Spalte E3:E45 die entsprechenden Werte/Daten in die E-Mail gezogen werden. Dieses funzt nicht richtig.
Der Automatische Versand klappt ja, nur die Auflistung aus E3:E45 stimmt nicht.
Könnte mir bitte jemand unter die Arme helfen.
LG Daniel
Option Explicit
Sub StartMail()
Dim strTo As String, strSUBJECT As String, strText As String, _
strCC As String, strBCC As String, strAtt As String, _
strEquipment As String
strEquipment = EquipmentListe
strTo = "blabla@bla.de" 'mehrere mit ; trennen
strSUBJECT = "Equipment Liste"
strText = "ACHTUNG Equipment " & vbCrLf & vbCrLf & _
strEquipment & vbCrLf & vbCrLf & _
"DATUM l?uft bald ab."
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
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = strTo
.CC = strCC
.BCC = strBCC
.Subject = strSUBJECT
For i = 0 To UBound(Split(strAtt, ";"))
.Attachments.Add Trim(Split(strAtt, ";")(i))
Next
.Body = strText
'.Send
End With
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Function EquipmentListe() As String
Dim rngC As Range
With Sheets("Komponentenfertigung")
For Each rngC In .Range(.Cells(3, 14), .Cells(45, 14))
If rngC