Office: Serienmail mit variabler Menge der Anhänge

Helfe beim Thema Serienmail mit variabler Menge der Anhänge in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Moin zusammen, ich probieren schon etwas herum und habe mich nun entschlossen um Hilfe zu bitten. Ich möchte Sereinmails mit Anhänge verschicken. Das... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Od!e, 26. Februar 2018.

Seite 1 von 2

OD!E

Od!e

Serienmail mit variabler Menge der Anhänge

Moin zusammen,

ich probieren schon etwas herum und habe mich nun entschlossen um Hilfe zu bitten.

Ich möchte Sereinmails mit Anhänge verschicken. Das funktioniert auch soweit.

Nun habe ich das Problem das ich immer genau die Anzahl an Anhängen haben muss was Programmiert ist.

Ich bin VBA Beginner und habe mir eigentlich alles zusammen gesucht was ich benötige. Sprich der Code ist nur bedingt auf meinem Mist gewachsen.

Code:

Sub Excel_Serial_Mail()

Dim objOLOutlook As Object
Dim objOLMail As Object

Dim lngMailNr As Long
Dim lngZaehler As Long
Dim strAttachmentPfad1 As String, strAttachmentPfad2 As String

On Error GoTo ErrorHandler

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

strAttachmentPfad1 = ActiveSheet.Range("J1")
strAttachmentPfad2 = ActiveSheet.Range("J2")

For lngZaehler = 2 To lngMailNr
If Cells(lngZaehler, 1) "" Then
Set objOLMail = objOLOutlook.CreateItem(olMailItem)
With objOLMail
.To = Cells(lngZaehler, 1).Value
.CC = ""
.BCC = ""
.Sensitivity = 0
.Importance = 1
.Subject = "Anfrage neues Bauvorhaben"
.BodyFormat = olFormatHTML
.Body = Cells(lngZaehler, 2) & "," & vbCrLf & vbCrLf & _
"bitte Prüfen Sie die Unterlagen und geben es auf Ihrer Deponie " & Cells(lngZaehler, 3).Value & " frei." & vbCrLf & vbCrLf & _
"Die Menge wird ca. " & Cells(lngZaehler, 4).Value & " betragen." & vbCrLf

.Attachments.Add strAttachmentPfad1
.Attachments.Add strAttachmentPfad2

.Display
VBA.SendKeys "^{END}", True
strSignatur = "Offiziell"
.GetInspector.CommandBars.Item("Insert").Controls("Signatur").Controls(strSignatur). _
Execute

.DeleteAfterSubmit = False
.Display
.Send
'.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

Sub OrdnerListen_Start()
Dim fso As Object

Application.ScreenUpdating = False

With ActiveSheet

Range("J1:J15").ClearContents

Set fso = CreateObject("Scripting.FileSystemObject")

Call OrdnerListen(fso, "X:BauleitungMusterprojektTest", .Range("J1")) ' Pfad anpassen!

Set fso = Nothing

End With

Application.ScreenUpdating = True

End Sub

Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As Long, Optional Spalte As Long)
Dim o, uo, f

Set o = fso.GetFolder(Ordnerangabe)

For Each f In o.Files
With rng.Offset(Zeile, 0)
.Value = f.Path
' .IndentLevel = 5
End With
Zeile = Zeile + 1

Next

Set f = Nothing

For Each uo In o.SubFolders
Spalte = Spalte + 1
Call OrdnerListen(fso, uo.Path, rng, Zeile, Spalte)
Spalte = Spalte - 1
Next

Set o = Nothing
Set uo = Nothing

End Sub

Sub Start_alle_Makro()

Call OrdnerListen_Start
Call Excel_Serial_Mail

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

Od!e, 26. Februar 2018

#1
LUSCHI

Luschi

Hallo Od!e,

so mach ich das: Code:

Sub Excel_Serial_Mail()
Dim objOLOutlook As Object
Dim objOLMail As Object

Dim rgAnhang As Range, rg As Range
Dim lngMailNr As Long
Dim lngZaehler As Long

Set rgAnhang = ActiveSheet.Range("J1:J15")
On Error GoTo ErrorHandler

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

strAttachmentPfad2 = ActiveSheet.Range("J2")

For lngZaehler = 2 To lngMailNr
If Cells(lngZaehler, 1) "" Then
Set objOLMail = objOLOutlook.CreateItem(olMailItem)
With objOLMail
.To = Cells(lngZaehler, 1).Value
.CC = ""
.BCC = ""
.Sensitivity = 0
.Importance = 1
.Subject = "Anfrage neues Bauvorhaben"
.BodyFormat = olFormatHTML
.Body = Cells(lngZaehler, 2) & "," & vbCrLf & vbCrLf & _
"bitte Prüfen Sie die Unterlagen und geben es auf Ihrer " & _
"Deponie " & Cells(lngZaehler, 3).Value & " frei." & _
vbCrLf & vbCrLf & "Die Menge wird ca. " & _
Cells(lngZaehler, 4).Value & " betragen." & vbCrLf

'*** Luschis Äanderungen *********************
For Each rg In rgAnhang
If Trim(rg.Value) "" Then
.Attachments.Add rg.Value
End If
Next rg
Set rg = Nothing: Set rgAnhang = Nothing
'*********************************************
.Display
VBA.SendKeys "^{END}", True
strSignatur = "Offiziell"

'Achtung: Dieser Befehl funktioniert nur bis Outlook 2010
'ab Outlook 2013 wurde das Objekt 'Commandbars' deaktiviert!!!
.GetInspector.CommandBars.Item("Insert").Controls("Signatur"). _
Controls(strSignatur).Execute
.DeleteAfterSubmit = False
.Display
.Send
'.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"

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß von Luschi
aus klein-Paris

Luschi, 27. Februar 2018

#2
OD!E

Od!e

Danke Luschi das du dir mein Problem angesehen hast.

zu den Signaturen: die sind mit nicht ganz so wichtig eher nice to have.
Ich habe mich noch weiter damit beschäftigt und bin auf eine andere Variante der Auswahl von anhängen gestoßen.
In der ich per Explorer die Anhänge auswählen kann. Leider mit nem Laufzeitfehler.
Vieleicht hast du hier auch eine Idee

Code:

Sub Excel_Serial_Mail()

Dim objOLOutlook As Object
Dim objOLMail As Object

Dim lngMailNr As Long
Dim lngZaehler As Long

On Error GoTo ErrorHandler

Set objOLOutlook = CreateObject("Outlook.Application")
Set objOLMail = objOLOutlook.CreateItem(0)
lngMailNr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For lngZaehler = 2 To lngMailNr
If Cells(lngZaehler, 1) "" Then
Set objOLMail = objOLOutlook.CreateItem(olMailItem)
With objOLMail
.To = Cells(lngZaehler, 1).Value
.CC = ""
.BCC = ""
.Sensitivity = 0
.Importance = 1
.Subject = "Anfrage neues Bauvorhaben"
.BodyFormat = olFormatHTML
.Body = Cells(lngZaehler, 2) & "," & vbCrLf & vbCrLf & _
"bitte Prüfen Sie die Unterlagen und geben es auf Ihrer Deponie " & Cells(lngZaehler, 3).Value & " frei." & vbCrLf & vbCrLf & _
"Die Menge wird ca. " & Cells(lngZaehler, 4).Value & " betragen." & vbCrLf

MsgBox ("Bitte Datei auswählen.")
Set fdOpen = Application.FileDialog(msoFileDialogOpen)
With fdOpen
.AllowMultiSelect = True
.InitialView = msoFileDialogViewList
'.InitialFileName = ActiveWorkbook.Path
.Title = "Bitte die zu sendende(n) Datei(en) auswählen!"
.ButtonName = "per E-Mail senden"
If .Show = True Then
Dim k As Integer
If .SelectedItems.Count > 0 Then
For k = 1 To .SelectedItems.Count
.Attachments.Add .SelectedItems(k)
Next
End If
End If
End With

.Display
VBA.SendKeys "^{END}", True
strSignatur = "Offiziell"
.GetInspector.CommandBars.Item("Insert").Controls("Signatur").Controls(strSignatur). _
Execute

.DeleteAfterSubmit = False
.Display
.Send
'.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
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Od!e, 28. Februar 2018

#3
LUSCHI

Luschi

Serienmail mit variabler Menge der Anhänge

Hallo Od!e,

solange Du in der Testphase bist, solltest Du solche Zeilen:
On Error GoTo ErrorHandler
deaktivieren (auskommentieren).
Denn was nützt die schönste Fehlermeldung, wenn man nicht weiß, in welcher Programmzeile der Fehler aufgetreten ist.

Gruß von Luschi
aus klein-Paris

Luschi, 28. Februar 2018

#4
OD!E

Od!e

Ja, das macht durch aus Sinn.

Od!e, 28. Februar 2018

#5
LUSCHI

Luschi

Hallo Od!e,

hast Du die fehlerhafte vba-Zeile gefunden und konntest die Ursache bereinigen?

fragt sich Luschi
aus klein-Paris

Luschi, 28. Februar 2018

#6
OD!E

Od!e

Nein leider nicht.
Geht bei mir auch erst Montag weiter.

Od!e, 1. März 2018

#7
OD!E

Od!e

Serienmail mit variabler Menge der Anhänge

so ich bin an einen Punkt gekommen an dem Ich wieder scheitere,
ich bekomme eine Meldung das und ungültiger Prozedur Aufruf oder ungültiges Argument.
Kann mir jemand weiter helfen?

Hier noch der Code die werden über zwei Button gesteuert
Code:

Function GetFolder(ByVal DefaultPath As String) As String
If Right(DefaultPath, 1) "" Then DefaultPath = DefaultPath & ""
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialView = msoFileDialogViewList
.InitialFileName = DefaultPath
.Show
If .SelectedItems.Count = 0 Then
GetFolder = ""
Else
GetFolder = .SelectedItems(1)
End If
End With
End Function

Sub Pfad_wählen()
Range("I1") = GetFolder("x:")
End Sub

Sub OrdnerListen_Start()
Dim fso As Object

Application.ScreenUpdating = False

With ActiveSheet

Range("J:J").ClearContents

Set fso = CreateObject("Scripting.FileSystemObject")

Call OrdnerListen(fso, .Range("I1"), .Range("J1")) ' Pfad anpassen!

Set fso = Nothing

End With

Application.ScreenUpdating = True

End Sub

Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As Long, Optional Spalte As Long)
Dim o, uo, f

Set o = fso.GetFolder(Ordnerangabe)

For Each f In o.Files
With rng.Offset(Zeile, 0)
.Value = f.Path
' .IndentLevel = 5
End With
Zeile = Zeile + 1

Next

Set f = Nothing

For Each uo In o.SubFolders
Spalte = Spalte + 1
Call OrdnerListen(fso, uo.Path, rng, Zeile, Spalte)
Spalte = Spalte - 1
Next

Set o = Nothing
Set uo = Nothing

End Sub

Sub Pfad()
Call Pfad_wählen
Call OrdnerListen_Start
End Sub

Sub Excel_Serial_Mail()
Dim objOLOutlook As Object
Dim objOLMail As Object

Dim rgAnhang As Range, rg As Range
Dim lngMailNr As Long
Dim lngZaehler As Long

Set rgAnhang = ActiveSheet.Range("J1:J15")
'On Error GoTo ErrorHandler

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

For lngZaehler = 2 To lngMailNr
If Cells(lngZaehler, 1) "" Then
Set objOLMail = objOLOutlook.CreateItem(olMailItem)
With objOLMail
.To = Cells(lngZaehler, 1).Value
.CC = ""
.BCC = ""
.Sensitivity = 0
.Importance = 1
.Subject = "Anfrage neues Bauvorhaben: " & Range("E2")
.BodyFormat = olFormatHTML
.Body = Cells(lngZaehler, 2) & "," & vbCrLf & vbCrLf & _
"bitte Prüfen Sie die Unterlagen und geben es auf Ihrer " & _
"Deponie " & Cells(lngZaehler, 3) & " frei." & _
vbCrLf & vbCrLf & "Die Menge wird ca. " & _
Cells(lngZaehler, 4) & " betragen." & vbCrLf

'*** Luschis Äanderungen *********************
For Each rg In rgAnhang
If Trim(rg.Value) "" Then
.Attachments.Add rg.Value
End If
Next rg
Set rg = Nothing: Set rgAnhang = Nothing
'*********************************************
.Display
VBA.SendKeys "^{END}", True
strSignatur = "Offiziell"

'Achtung: Dieser Befehl funktioniert nur bis Outlook 2010
'ab Outlook 2013 wurde das Objekt 'Commandbars' deaktiviert!!!
.GetInspector.CommandBars.Item("Insert").Controls("Signatur"). _
Controls(strSignatur).Execute
.DeleteAfterSubmit = False
.Display
'.Send
'.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"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Od!e, 5. März 2018

#8
LUSCHI

Luschi

Hallo Pascal,

Du verwendest 2 Outlook-Konstanten, die Dir aber so nicht zur Verführung stehen, da Du 'Late Binding' (Set objOLOutlook = CreateObject("Outlook.Application")) verwendest. Dadurch ist die Outlook-Bibliothek als vba-Verweis nicht eingebunden und die Konstanten sind nicht aufrufbar.
Endweder Du definierst die Variablen im Code selbst:
Const olFormatHTML As Integer = 2
Const olMailItem As Integer = 0
oder setzt an den entsprechenden Stellen den Zahlenwert direkt ein.

Gruß von Luschi
aus klein-Paris

Luschi, 6. März 2018

#9
OD!E

Od!e

Danke, dass du dir nochmal die Zeit genommen hast dir der den Code nochmal an zusehen.
Was ich nicht verstehe ist warum der Code " einseparat " funktioniert.

Od!e, 6. März 2018

#10
LUSCHI

Luschi

Hallo Pascal,

Was ich nicht verstehe ist warum der Code " einseparat " funktioniert.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was meinst Du damit?

fragt sich Luschi
aus klein-Paris

Luschi, 6. März 2018

#11
OD!E

Od!e

Ups, hatte vom Handy geschrieben. Ich wollte damit sagen, wenn ich den Code in einer neuen Liste anwende das es ohne Probleme funktioniert.
Ich glaube aber das ich mich hier in etwas fest beiße wo es vergeben mühe ist.
Zu mal ich eigentlich keine Ahnung von VBA habe und alles irgendwie zusammen Kopiert habe.
Ich lasse mir jetzt alle Mails generieren und füge dann meine Anhänge ein.

Od!e, 6. März 2018

#12
LUSCHI

Luschi

Serienmail mit variabler Menge der Anhänge

Hallo Pascal,

wenn Du soweit gekommen bist, wirst Du doch jetzt die Flinte nicht ins Korn werfen. Mein Vorschlag:
-anonymisiere die Daten in dern xlsm-Datei so weit wie nötig
-alles was die Datei dick & fett macht schmeiße raus
-schreibe die Dateinamen samt Pfad in einen bestimmten Tabellenbereich
- die Dateinamen selbst können beliebig heißen
- der Pfad sollte aber stimmen
- und lade die Datei hier hoch
- ich erzeuge mir die gewünschten Pfade und die Dummy-Dateien
Und dann kriegen wir das schon hin.

Gruß von Luschi
aus klein-Paris

Luschi, 6. März 2018

#13
OD!E

Od!e

Echt super von dir.
Im Grunde hatte ich auch das Gefühl das ich kurz vor meinem Ziel stehe.

Das Problem ist das ich keinen festen Datenpfad anlegen wollte. Da ich sonnst immer Daten dort hin legen müsste und im Anschluss wieder den Pfad bereinigen.

Ich habe mal die Excel an gehangen.

Od!e, 7. März 2018

#14
LUSCHI

Luschi

Hallo Pascal,

Du hattest Recht und warst bereits kurz vor dem Marathon-Stadion mit der Zielgeraden. Hier meine Änderungen mit ein paar Bemerkungen.

Gruß von Luschi
aus klein-Paris

Luschi, 7. März 2018

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

Serienmail mit variabler Menge der Anhänge

Die Seite wird geladen...

Serienmail mit variabler Menge der Anhänge - Similar Threads - Serienmail variabler Menge
Serienmail automatisch über zweites Outlook Konto
in Microsoft Outlook Hilfe
Serienmail automatisch über zweites Outlook Konto: Hallo, ich nutze Outlook bei der Arbeit mit zwei verschiedenen Konten. Nun möchte ich über das Projekt-Konto Serienmails verschicken, aber Outlook versendet immer über mein persöniches Konto. In...
mit VBA eine Serienbrief-Mail mit mehreren Anhängen erstellen
in Microsoft Word Hilfe
mit VBA eine Serienbrief-Mail mit mehreren Anhängen erstellen: Hallo zusammen, ich habe die Anforderung eine Mail mit 3 Anhängen an ca. 900 Empfänger zu verschicken. Die Mailkontakte habe ich in einer Excel-Datei vorliegen. Ich hatte es über die...
Serienmails an mehrere E-Mail-Adressen pro Kontakt nicht mögllich
in Microsoft Outlook Hilfe
Serienmails an mehrere E-Mail-Adressen pro Kontakt nicht mögllich: Hallo, wir haben in der Firma ein Problem beim Versand von Serienmails. Wir haben bei den Outlook-Kontakten Kategorien hinterlegt. Damit sortieren wir die Empfängergruppen. Z.B. werden für...
Personalisierte Serienmails, Fehlermeldung: Word konnte die Datenquelle nicht öffnen
in Microsoft Outlook Hilfe
Personalisierte Serienmails, Fehlermeldung: Word konnte die Datenquelle nicht öffnen: Hallo, habe Outlook und Word 2010. Versuche für selektierte Outllook Kontakte personalisierte Serienmails zu versenden. Nachdem ich die Auswahlpunkte im Seriendruck Dialogfeld "Kontakte...
Makro für Outlook um PDF-Datei anzuhängen
in Microsoft Outlook Hilfe
Makro für Outlook um PDF-Datei anzuhängen: Hallo, ich muss eine Serienmail an etwas über 1.000 Adressen schicken. Diese sind alle fertig, nun muss ich nur noch eine PDF Datei anhängen. Leider muss ich hierzu jede Mail einzeln öffnen und...
Serienmails mit Word 2010 und Outlook 2010
in Microsoft Outlook Hilfe
Serienmails mit Word 2010 und Outlook 2010: Hi Leute, sorry ich bin neu hier und habe jetzt knapp 2 Std gesucht. Ich hoffe mein Beitrag gibt es wirklich noch nicht so das Ihr mir schnell helfen könnt. Vielen Dank dafür schon mal im...
Serienmail mit Word 2010 über Outlook 2013
in Microsoft Outlook Hilfe
Serienmail mit Word 2010 über Outlook 2013: Hallo zusammen, ich hab das Problem das ich keine Serienmails verschicken kann über Word 2010. Ich hab die Serienmails angelegt, hat alles funktioniert wie es soll, jedoch beim Fertig stellen...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden