Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1028to1032
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Serienmail mit verschiedenen Attachments aus einer

Serienmail mit verschiedenen Attachments aus einer
10.12.2008 22:15:00
Claudia
Hallo guten Abend an alle,
ich sitze schon eine ganze Weile an meinem Problem und schaffe es nicht.
Nachstehenden Code habe ich vor einiger Zeit hier im Forum gefunden. Funzt auch echt super gut. In diesem Code wird in Zelle F2 der Pfad und der Dateiname einer Datei angegeben, die als Anlage allen Mails mitgegeben wird.
Ich möchte aber gerne (da ich immer nur 3 Mails sende) das ich pro Mail jeweils eine eigene Datei als Anhang sende. Also müsste ich in F1, in F2 und in F3 jeweils einen Pfad angeben können der dann für die jeweils zugehörige Mail gedacht ist.
Ich hoffe das ist verständlich ausgedrückt.
'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 3) 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 Serienmail_mit_Anlagen()
'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 = 3  'Hier wird die Anzahl der zu sendenden Empfänger (Zeilen) eingetragen
'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 : F2
For y = 2 To 2
'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


Danke im voraus für Eure Hilfe.
Gruß
Claudia

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Serienmail mit verschiedenen Attachments aus einer
11.12.2008 09:23:19
gerwas
Hallo
Steht denn irgendwo, wer welchen Dateianhang erhalten soll?
Oder warum erzeugst du nicht einen Datensatz:
mit dem jeweiligen empfänger im spalte 1
dem dazugehörigen dateianhang 1 in spalte 2
den weiteren dateianhänge in spalte 3 bis...
Gruss GerWas
AW: Serienmail mit verschiedenen Attachments aus einer
11.12.2008 09:28:00
Claudia
Hallo Gerwas,
ich möchte gerne das Empfänger 1 aus A1 seinen Dateianhang in Zelle D1 oder alternativ F1 angegeben bekommt,
Empfänger 2 aus A2 seinen Dateianhang in Zelle D2 oder alternativ F2 angegeben bekommt,
Empfänger 3 aus A3 seinen Dateianhang in Zelle D3 oder alternativ F3 angegeben bekommt.
In der Spalte B steht ja immer der Betreff der Mail und in Spalte C ist der Text der Mail.
Hoffe habe das verständlich ausgedrückt.
Gruß
Claudia
Anzeige
AW: Serienmail mit verschiedenen Attachments aus einer
11.12.2008 09:35:00
Armin
Hallo Claudia,
dann so:

Sub Serienmail_mit_Anlagen()
'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 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 = 3  'Hier wird die Anzahl der zu sendenden Empfänger (Zeilen) eingetragen
'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
'2. Fehlerprüfung
'Mit dem FilesystemObjekt wird zuerst die Existenz
'der Dateien geprüft. Wenn eine nicht existiert
'wir diese Attachment nicht angehängt
'Sendevorgang einleiten
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"
'Wenn die Zelle / Variable leer ist
'wird kein Attachments gesendet
For y = 0 To 1
If Cells(i, 6 + y)  "" Then
If fs.fileexists(Cells(i, 6 + y)) = True Then
.attachments.Add Cells(i, 6 + y)
End If
End If
Next
'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


Gruß Armin

Anzeige
AW: Serienmail mit verschiedenen Attachments aus einer
11.12.2008 09:56:43
Claudia
Hallo Armin,
mit Spalte D funzt es leider gar nicht, und bei Spalte F in Deinem anderen Beispiel meckert es beim End With.
Habe deshalb noch mal auf offen gestellt.
Gruß Claudia
AW: Serienmail mit verschiedenen Attachments aus einer
11.12.2008 09:29:25
Armin
Hallo Claudia,
wenn ich es richtig verstanden habe soll in F1:3 der Pfad und der File-Name des Attachments stehen.
Dann müsste Du das so ändern:

Sub Serienmail_mit_Anlagen()
'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 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 = 3  'Hier wird die Anzahl der zu sendenden Empfänger (Zeilen) eingetragen
'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
'2. Fehlerprüfung
'Mit dem FilesystemObjekt wird zuerst die Existenz
'der Dateien geprüft. Wenn eine nicht existiert
'wird kein Attachments angehängt
'Sendevorgang einleiten
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"
'Wenn die Zelle / Variable leer ist
'wird kein Attachments gesendet
If Cells(i, 6)  "" Then
If fs.fileexists(Cells(i, 6)) = True Then
.attachments.Add Cells(i, 6)
End If
'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


Grüße von
Armin

Anzeige
AW: Serienmail mit verschiedenen Attachments aus einer
11.12.2008 09:44:00
Claudia
Hallo Armin,
das mit Spalte F ist schon sehr gut und besser als mit Spalte D, aber er meckert immer beim letzten End With (End With ohne With).
Kannst Du noch mal drüberschauen?
Danke Gruß Claudia
AW: Serienmail mit verschiedenen Attachments aus einer
11.12.2008 10:04:00
Armin
Hallo Claudia,
hatte es nicht getestet, aber jetzt müsste es gehen.
Wenn Attachments in D, E,F stehen werden diese jeweils angehängt;Also max. 3pro Mail.

Sub Serienmail_mit_Anlagen()
'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 AnzEmpfänger As Integer
Dim ATT As String
'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 = 3  'Hier wird die Anzahl der zu sendenden Empfänger (Zeilen) eingetragen
'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
'2. Fehlerprüfung
'Mit dem FilesystemObjekt wird zuerst die Existenz
'der Dateien geprüft. Wenn eine nicht existiert
'wir diese Attachment nicht angehängt
'Sendevorgang einleiten
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"
'Wenn die Zelle / Variable leer ist
'wird kein Attachments gesendet
For y = 0 To 2
If Cells(i, 4 + y)  "" Then
If fs.fileexists(Cells(i, 4 + y)) = True Then
ATT = Cells(i, 4 + y)
.attachments.Add ATT
End If
End If
Next
'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


Grüße Armin

Anzeige
suuuper funzt einwandfrei. Danke o.T.
11.12.2008 10:08:00
Claudia

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige