Bestellungen per E-Mail aus Excel heraus
Vor ein paar Wochen habe ich ein kleines Bestelltool in Excel gebaut, um die Bestellungen bei Danielz‘ Foodtruck zu vereinfachen.
Ausgangspunkt ist eine kleine Tabelle, in der die einzelnen Gerichte mit den Preisen aufgeführt sind. Über die Menge wird dann der jeweilige Preis ausgerechnet und die Summe gebildet. Es sind verschiedene Ranges definiert (für die Ziel-E-Mail-Adresse, den Standard-Betreff, etc.) die wichtigste ist aber die Auswahl-Range, die die gesamte Tabelle mit den Gerichten umfasst.
Mit ein wenig VBA wird dann die Outlook-Mail erzeugt.
Den Namen des Benutzers könnte man theoretisch per VBA.Environ("Username") ermitteln, dies liefert aber nur das Login und nicht den Klarnamen. Dazu ist eine Abfrage des Active Directory (siehe https://technet.microsoft.com/en-us/library/2007.08.heyscriptingguy.aspx) notwendig:
Function GetUsername()
Set objAD = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objAD.UserName)
GetUsername = objUser.DisplayName
End Function |
Über die getOrder() Funktion erstellen wir den String für den jeweiligen Besteller aus der Tabelle.
Function getOrder()
auswahl = Range("Auswahl")
bestellstring = "* " & GetUsername() & ": "
Order = 0
For i = 1 To UBound(auswahl)
If (auswahl(i, 3)) > 0 Then
If Order > 0 Then
bestellstring = bestellstring & ", "
End If
bestellstring = bestellstring & auswahl(i, 3) & " x " & auswahl(i, 1)
Order = 1
End If
Next i
Debug.Print bestellstring
getOrder = bestellstring
End Function |
Im letzten Schritt gilt es nur noch, den erzeugten String per Mail zu versenden. Hier waren die Code-Schnipsel von http://www.rondebruin.nl/win/winmail/Outlook/tips.htm sehr hilfreich. Hinweis: Der Button im Bestellformular ist an diese Sub gebunden.
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hier ist meine Bestellung:" & vbNewLine & vbNewLine & vbNewLine
body = getOrder()
If Len(Range("kommentar") > 0) Then
body = body & vbNewLine & Range("kommentar")
End If
On Error Resume Next
With OutMail
.To = Range("receiver")
.CC = ""
.BCC = ""
.Subject = Range("subject")
.body = strbody & body
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
