Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Dynamischer eMail Versand aus Excel heraus

Betrifft: Dynamischer eMail Versand aus Excel heraus von: Tibu
Geschrieben am: 27.08.2004 10:40:14

Guten Morgen allerseits,

Ich habe eine Excel-Sheet, welches per eMail verschickt werden kann.
In H8 habe ich verschiedene Abkürzungen, welche verschiedene Empfänger darstellen sollen. Die Werte in H8 werden aus einer ValidationListe von U7:U12 herausgezogen.

Im Comand-Button habe ich nun folgenden Code

Code:

Private Sub CommandButton1_Click() 

    Dim OutApp As Object 
    Dim OutMail As Object 
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(olMailItem) 
    With OutMail 
        .To = "XXX" 
        .CC = "avtr@gmx.net , tiburon@ist-einmalig.de" 
        .BCC = "" 
        .Subject = "[Tiburon Betreff]" 
        .Body = "Liebe Freunde, " & vbLf & _ 
        "" & vbLf & _ 
        "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Pellentesque massa.." & vbLf & _ 
        "Suspendisse pellentesque magna et mi. Nunc feugiat tempor wisi. Sed consequat odio sit amet arcu. Sed sollicitudin nibh sit amet orci." & vbLf & _ 
        "" & vbLf & _ 
        "Mit freundlichen Grüßen" & vbLf & _ 
        Application.UserName 
        .Attachments.Add ActiveWorkbook.FullName 
        .Display 
    End With 
    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub




Soweit so gut, das funktioniert nun auch alles, doch ich würde gerne den Empfänger so erstellen lassen, daß je nach dem wer in H8 als Abkürzung drinne steht, derjenige dann auch die eMail empfängt. Die eMail Adressen von den Leute, die in H8 sind, stehen in W7:W12.

Wie kann ich also dieses .To so ändern, daß es je nach Wert in H8 dynamisch die eMail Addresse aus W7:W12 zieht.

Vielen Dank schon allen Experten!

Lieben Gruss

Tibu
  


Betrifft: AW: Dynamischer eMail Versand aus Excel heraus von: Jens M
Geschrieben am: 27.08.2004 12:51:18

Hallo Tibu!

Ich habe hier was aus meiner Sammlung; müsstest es etwas anpassen:

Grüße,
Jens

========================================================================================

In diesem Beispiel stehen in der aktiven Tabelle in A1 bis A10 E-Mail-Adressen ( deshalb die Schleife von 1 bis 10 )
Sub Excel_Serienmail_via_Outlook_Senden()
    Dim OutApp As Object, Mail As Object
    Dim i As Integer
    Dim Nachricht
    For i = 1 To 10
    'Variablen müssen bei jeder Schleife neu initalisiert werden
        Set OutApp = CreateObject("Outlook.Application")
        Set Nachricht = OutApp.CreateItem(0)
        With Nachricht
            .To = Cells(i, 1)'Adresse
            .Subject = Cells(i, 2) 'Betreffzeile
            .Body = Cells(i, 3) 'Sendetext
            'Hier wird die Mail zuerst angezeigt
            '.Display
            'Hier wird die Mail gleich in den Postausgang gelegt
            .Send
        End With
        'Variablen zurücksetzen sonst geht es nicht
        Set OutApp = Nothing 'CreateObject("Outlook.Application")
        Set Nachricht = Nothing 'OutApp.CreateItem(0)
        Application.Wait (Now + TimeValue("0:00:05"))
    Next i
End Sub



Serienmail mit verschiedenen Attachments aus einer Tabelle mit Outlook senden
Ein ähnliches Beispiel wie oben mit dem Unterschied, dass die Empfänger in den Zellen stehen und
die jeweiligen Attachments ( in diesem Fall 10 ) stehen inclusive Pfad in den Zellen F2:F10
die jeweiligen Attachments mit den Pfadangaben in den Nachbarzellen.
In diesem Beispiel wird das FileSystemObject zu Hilfe genommen um die Ordner bzw. die Dateien auf Existenz zu testen.
Das ganze könnte auch etwas einfacher gelöst werden, aber so kann das FS-Object wunderbar gezeigt werden.
Sub Excel_Serienmail_mit_mehreren_Anlagen_via_Outlook_Senden()
    'Variablendefinition
    Dim fs As Object, F As Object
    Dim OutApp As Object, Mail As Object
    Dim i As Integer, y As Integer, Msg As Integer
    Dim Nachricht As Variant
    Dim AWS As String
    Dim AnzEmpfänger As Integer
    'Variablen füllen
    'Filesystemobjekt erstellen
    Set fs = CreateObject("Scripting.FileSystemObject")
    'Hier die Anzahl Empfänger definieren
    'Kann auch ein Range auf der Tabelle sein
    AnzEmpfänger = 10
    '1. Fehlerprüfung
    'Prüfen ob alle Inhalte vorhanden sind
    'Wenn nicht wird das Makro abgebrochen
    'In Spalte A steht der Name
    'In Spalte B steht der Betreff
    'In Spalte C steht der Text
    For i = 1 To AnzEmpfänger
        If Cells(i, 1) = "" Or Cells(i, 2) = "" Or Cells(i, 3) = "" Then
            Msg = MsgBox("Unvollständige Angaben beim Empfänger in Zeile "_
		 & i, vbCritical + vbOKOnly, "Abbruch")
            Exit Sub
        End If
    Next i
    '2. Fehlerprüfung
    'Mit dem FilesystemObjekt wird zuerst die Existenz
    'der Dateien geprüft. Wenn eine nicht existiert
    'wird das Makro abgebrochen
    'Die Links auf deine Anlagen liegen im
    'Bereich F2 : F10
    For y = 2 To 10
        'Wenn eine Zelle leer ist, wird aus der Schleife ausgestiegen
        'ohne weitere Fehlerprüfung
        If Cells(y, 6) = "" Then Exit For
        If fs.fileexists(Cells(y, 6)) = False Then
            Msg = MsgBox("Die Datei: " & Cells(y, 6) & " in F" & y & " exitstiert nicht !"_
		 & vbCrLf & "Der Sendevorgang an; " & Cells(i, 1) & " wird abgebrochen!",_
		  vbCritical + vbOKOnly, "Dateifehler")
            Exit Sub
        End If
    Next y
    'Sendevorgang einleiten
    For i = 1 To AnzEmpfänger
        Set OutApp = CreateObject("Outlook.Application")
        Set Nachricht = OutApp.CreateItem(0)
        With Nachricht
            .To = Cells(i, 1) 'irgendwer@irgendein-provider.de
            .Subject = Cells(i, 2) 'Betreffzeile
            .Body = Cells(i, 3) 'Sendetext"
            For y = 2 To 10
                AWS = Cells(y, 6)
                'Wenn die Zelle / Variable leer ist
                'wird diese Schleife für die Attachments abgebrochen
                If AWS = "" Then Exit For
                .attachments.Add AWS
            Next y
            'Hier wird die Mail zuerst angezeigt
            .Display
            'Hier wird die Mail gleich in den Postausgang gelegt
            '.Send
        End With
        'Variablen zurücksetzen
        Set OutApp = Nothing
        Set Nachricht = Nothing
        'Warten auf Outlook :-))
        Application.Wait (Now + TimeValue("0:00:05"))
    Next i
End Sub



  


Betrifft: AW: Dynamischer eMail Versand aus Excel heraus von: Tibu
Geschrieben am: 30.08.2004 13:15:32

Hallo Jens,

erstmal vielen Dank für Deine Hilfe, leider ist es nicht das was ich möchte. Ich will keine Serienmail verschicken sondern je nach dem was in H8 drinne ist, eine einzige eMail, die sich dann auch w7:w12 die richtige herauszieht.

Danke Dir nochmals

Gruss

Tibu


 

Beiträge aus den Excel-Beispielen zum Thema "Dynamischer eMail Versand aus Excel heraus"