Excel stürzt bei mehrfachen E-Mail Versand ab
08.07.2025 13:37:14
velo
ich habe ein VBA Tool in Excel aufgebaut, mit dem man verschiedene Berichte bauen kann, sowohl in Gesamtbetrachtung als auch auf einzelne Kostenstellen.
Die erzeugten Berichte werden immer als neue Datei im Downloads-Ordner abgespeichert.
Das ganze Tool läuft eigentlich ziemlich rund, ich bin aber grade dabei im Nachhinein noch eine Funktion hinzuzufügen, mit der die Kostenstellenberichte automatisch den jeweiligen Verantwortlichen per Mail gesendet werden.
Ich habe die Funktion dem UserForm (ufVerantw) hinzugefügt, mit dem man sonst immer die Kostenstellenberichte erstellen konnte.
Das UF hat eine ComboBox mit allen Verantwortlichen (geladen per Dictionary aus der Datenbasis). Aus dieser ComboBox Liste zieht sich jetzt die neue Prozedur, die Namen der Verantwortlichen. Über diese Namen werden, dann per Range.Find noch die E-Mail Adressen aus einem "Stammdaten" Worksheet gezogen.
Anschließend wird ein Einzelbericht zu diesem Verantwortlichem erstellt (wie oben bereits gesagt, eigene Datei gespeichert in Downloads), der Pfad zu dem ermittelt und anschließend geschlossen.
Zum Schluss wird dann anhand des Namens, der E-Mail-Adresse und anhand des Pfads des Einzelberichts eine E-Mail an den Verantwortlichen versendet.
Nach der Beschreibung jetzt endlich zum Problem:
Das ganze funktioniert beim ersten Ausführen genau so wie es soll - die Berichte werden aufgebaut, abgespeichert und als Mail versendet, ohne irgendwelche Probleme.
Wenn ich das ganze im Anschluss aber nochmal machen will, dann stürzt mir Excel ab.
Wieso?? Gibt es hier irgendwie ein Problem mit dem Arbeitsspeicher?
Hier noch der Code:
Option Explicit
Private Sub buttonAll_Click()
Dim answer As VbMsgBoxResult
Dim i As Long
Dim strVer As String
Dim strMail As String
Dim strPath As String
Dim wsBereich As Worksheet: Set wsBereich = Bereich
Dim rngVer As Range
Dim wbBericht As Workbook
'Abfrage, ob wirklich alle Verantwortlichen einen Bericht erhalten sollten oder nur einzelne
answer = MsgBox("Sollen die Einzelberichte wirklich an ALLE Verantwortlichen versendet werden?", vbYesNoCancel, "Berichte versenden")
If answer = vbCancel Then
Exit Sub
ElseIf answer = vbNo Then
'Work in progress
MsgBox "Weiterleiten zum abwählen von Verantwortlichen"
ElseIf answer = vbYes Then
'Wenn alle Verantwortlichen einen Bericht erhalten sollen, dann die ComboBox Liste durchgehen und für jeden einzelnen
'Verantworlichen die E-Mail Adresse mittels Rng.Find rausfischen
For i = 1 To cbVer.ListCount
strVer = cbVer.List(i - 1)
Set rngVer = wsBereich.Range("A:A").Find(strVer, LookIn:=xlValues, lookat:=xlWhole)
'Wenn mittels Rng.Find der Verantwortliche gefunden wurde, dann den Einzelbericht aufbauen.
'Den Einzelbericht wieder schließen und den Pfad, sowie Name und Mail des Verantworlichen an SendMail weitergeben
If Not rngVer Is Nothing Then
strMail = rngVer.Offset(0, 6).Value
'Erstellen des Einzelberichts, ermitteln des Pfads und schließen
Call Einzelbericht(strVer)
Set wbBericht = Application.Workbooks("Report " & strVer & " " & Format(Date, "yyyy-mm-dd"))
strPath = wbBericht.FullName
wbBericht.Close
Call SendMail(strVer, strMail, strPath)
End If
Next i
End If
Unload ufVerantw
End Sub
Private Sub SendMail(strVer As String, strMail As String, strPath As String)
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
'rudimentärer Check, ob E-Mail-Adresse mitgegeben wurde, muss fürs erste reichen
If Not InStr(1, strMail, "@") > 0 Then
Exit Sub
End If
'Prüfen, ob Outlook bereits eine Outlook Instanz vorhanden ist,
'wenn nicht dann eine neue starten
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
Set olApp = New Outlook.Application
End If
'Die Mail aufbauen und anschließend versenden
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = strMail
.Subject = "Bericht " & strVer
.Body = "Hallo," & vbNewLine & vbNewLine & _
"test, test, test" & vbNewLine & vbNewLine & _
"VG"
.Attachments.Add strPath
.Send
End With
'Aufräumen
Set olApp = Nothing '--> notwendig??
Set olMail = Nothing
End Sub
Ich danke bereits im Voraus für eure Inputs!
VG
velo
P.S. Ich weiß, dass der Code nicht gerade eine Augenweide ist man hier viele Sachen eleganter lösen könnte, das ganze ist aber wie oben beschrieben eine Funktion an die erst im Nachhinein gedacht wurde und jetzt erstmal funktionieren muss.
Anzeige