VBA dynamische Aufzählung in Email

Moderator: ModerationP

VBA dynamische Aufzählung in Email

Beitragvon Game_Browser » 14. Jan 2019, 15:05

Hallo an die VBA Experten und Expertinnen,

ich würde gern bei der Serienmail-Erstellung verschiedene Produkte eines Lieferanten zuammenfassen.

Die normale Serienmail-Erstellung pro Zeile funktioniert schon sehr gut.

Um aber einem Lieferanten 3 oder mehr Emails zu jeweils einem Produkt zu ersparen würde ich diese gern für jeden Lieferanten automatisch zusammenführen lassen so das jeder Lieferant die Email für alle seine Produkte bekommt.

So sollen folgende Emails erstellt werden:

Lieferant A eine Email für Produkt 1,3 und 2
Lieferant B eine Email für Produkt 2 und 1
Lieferant C eine Email für Produkt 2

Ich könnte mir vorstellen das das mit einer Schleife realisierbar wäre aber ich komme einfach nicht drauf.

Vielen Dank für eure Unterstützung.

Code: Alles auswählen
Sub Excel_Serial_Mail()
    Dim objOLOutlook As Object
    Dim objOLMail As Object
   
    Dim lngMailNr As Long
    Dim lngZaehler As Long
    Dim strSignatur As String

On Error GoTo ErrorHandler

Set objOLOutlook = CreateObject("Outlook.Application")
lngMailNr = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

For lngZaehler = 2 To lngMailNr
    If Cells(lngZaehler, 1) <> " " Then
        Set objOLMail = objOLOutlook.CreateItem(0)
        With objOLMail
            .To = Cells(lngZaehler, 3) 'Zahl gibt die Spalte mit der Emailadresse an
            .CC = ""
            .BCC = ""
            .GetInspector.Activate
            strSignatur = .Body
            .Sensitivity = 1
                '0 = normal
                '1 = persönlich
                '2 = privat
                '3 = vertraulich
            .Importance = 1
                '0 = normal
                '1 = persönlich
                '2 = privat
                '3 = vertraulich
            .Subject = "Rechnung" & " " & "(" & "Lieferant" & " " & Cells(lngZaehler, 4) & ")"
            .BodyFormat = 2 'olFormatHTML
            '.HTMLBody = "<HTML><H2>The body of this message will appear in HTML.</H2><BODY>Type the message text here. </BODY></HTML>"

                'plain = nur Text
                'HTML = wenn formatierungen enthalten sind (Standard)
            .Body = "Sehr geehte Damen und Herren" & vbCrLf & _
                "Aufzählung" & vbCrLf & _
                Cells(2, 1) & " " & Cells(2, 2) & vbCrLf & _
                "Bitte schicken Sie uns die erforderlichen Dokumente bis zum " & "Datum" & " wieder zurück, damit wir den Vorgang abschließen können." & strSignatur
           
            'alle von einem Lieferanten gelieferten Produkte zusammen aufzählen.
           
            .DeleteAfterSubmit = False
           
                'Email wird direkt gesendet
                '.Send
               
                'Email wird zum ändern angezeigt und muss manuell gesendet werden
                .Display
        End With
        Set objOLMail = Nothing
    End If
Next lngZaehler
Set objOLOutlook = Nothing

Exit Sub

ErrorHandler:
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source, _
        vbInformation, "Ein Fehler ist aufgetreten"
Exit Sub
End Sub
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Arbeitsrechner
BS: Windows 7
MS Office 2010
Game_Browser
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 24
Registriert: 15. Sep 2015, 09:03

Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: Flotter Feger, MemoMS und 22 Gäste