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

Uwe

Hat Dir dieser Beitrag geholfen und möchtest Du Dich dafür bedanken? Dann unterstütze doch vielleicht die Dingfabrik Köln e.V. mit einem kleinen Beitrag. Details zur Bezahlung findest Du unter Spenden für die Dingfabrik.

More Posts - Website