AW: Bestellung erzeugen und per Mail senden
16.02.2024 13:02:41
Alwin Weisangler
Hallo Sascha,
Du wirst sicherlich schon festgestellt haben, dass etliche Provider dies blocken. Der bessere Weg ist über Outlook selbst es zu erschlagen.
Wenn du wirklich nur die Bestellung aus dieser Tabelle machen willst ohne viel Aufwand mit 'nen bissel HTML würde ich es so machen:
Option Explicit
' mal mit Early Binding Bilbiothek (MS Outlook 16.0) in Extras/Verweise muss somit aktiviert sein.
' Late Binding gibt es Beispiele in Masse im Netz
Sub BestellungInMail()
Dim Outobj As Outlook.Application
Dim Mail As Object
Dim arr(), TabKopf$, TabWerte$, SendenAn$, SendenCC$, Betreff$, Anrede$, Ende$, iSpalten&, SpalteMengen&, i&, j&, k&
' Vorgaben - diese lassen sich per Auswahlliste ebenfalls automatiert übergeben
iSpalten = 9
SpalteMengen = 9
Anrede = "Hallo!
Anbei meine Bestellungen.
"
Ende = "
Mit freundlichen Grüßen
Dein Name
"
SendenAn = "test@testserver.de"
SendenCC = "testserver.de" ' Wenn keine dann SendenCC = ""
Betreff = "Bestellung: Material"
' Ende deiner Vorgaben
' ab hier nichts verändern
With Tabelle1
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, SpalteMengen) > 0 Then k = k + 1
Next i
ReDim arr(1 To k, 1 To iSpalten)
k = 0
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, SpalteMengen) > 0 Then
k = k + 1
For j = 1 To iSpalten
arr(k, j) = .Cells(i, j)
Next j
End If
Next i
End With
For i = 1 To UBound(arr, 1) ' Aufbereitung der Tabelle
If i = 1 Then ' Aufbereitung des Tabellenkopfs
TabKopf = TabKopf & ""
For j = 1 To UBound(arr, 2)
TabKopf = TabKopf & "" & arr(i, j) & " | "
Next j
TabKopf = TabKopf & ""
Else ' Aufbereitung der Tabellenzeilen
TabWerte = TabWerte & "
"
For j = 1 To UBound(arr, 2)
TabWerte = TabWerte & "" & arr(i, j) & " | "
Next j
TabWerte = TabWerte & "
"
End If
Next i
TabWerte = TabWerte & "
' ab hier Mail nebst Inhalt erzeugen
Set Outobj = New Outlook.Application
With Outobj.CreateItem(0)
.GetInspector.Display ' öffnet den erzeugten Item
.To = SendenAn
.CC = SendenCC
.Subject = Betreff
.HTMLBody = Anrede & TabKopf & TabWerte & Ende ' Übergabe Texte und Tabelle an den Body der Mail
.Send
End With
Set Outobj = Nothing
End Sub
Das sollte so problemlos anpassbar sein.
Es geht natürlich auch ohne den ganzen Arraykram: neues Tabellenblatt erzeugen --> Bestelltabelle in Spalte 9 filtern --> gefilterte Werte kopieren --> neue Tabelle kopierte Werte einfügen und dieses Tabellenblatt ab in den Anhang.
Ich wollte es aber eben mal so ausführen.
https://www.herber.de/bbs/user/167089.xlsm
Gruß Uwe