Email an verschiedene Empfänger
08.09.2022 12:01:19
Hotte1010
ich habe mir einen VBA Code gebastelt, womit ich an verschiedene, sich wechselnde, Empfänger, eine Email versenden kann.
Mein Code funktioniert auch soweit. Trotzdem habe ich noch ein Problem.
Ich möchte auch das aktuelle Arbeitsblatt der Exceldatei mit der Email schicken.
Ich habe schon diverse Versuche gestartet, doch immer wieder scheitere ich an kleineren Problemen.
Kann mir jemand weiterhelfen?
Hier mein Code:
Sub Email_senden()
Dim oAppOutlook As Object
Dim i As Long
Dim sAbteilung As String
Dim sTemp As String
Dim sTemp2 As String
'Hier wird .to gesetzt
sAbteilung = Sheets("Daten").Cells(1, 2).Value
sTemp = ""
With Sheets("Daten")
For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1
If .Cells(i, 1).Value = sAbteilung Then
sTemp = sTemp & .Cells(i, 4).Value & ";"
End If
Next i
'Das letzte Semikolon entfernen
If Trim(sTemp) "" Then
sTemp = Left(sTemp, Len(sTemp) - 1)
End If
End With
'Hier wid .CC beigefügt
sAbteilung = Sheets("Daten").Cells(1, 2).Value
sTemp2 = ""
With Sheets("Daten")
For i = 4 To .UsedRange.Rows.Count + .UsedRange.Row - 1
If .Cells(i, 6).Value = sAbteilung Then
sTemp2 = sTemp2 & .Cells(i, 9).Value & ";"
End If
Next i
'Das letzte Semikolon entfernen
If Trim(sTemp2) "" Then
sTemp2 = Left(sTemp2, Len(sTemp2) - 1)
End If
End With
'Wenn mindestens eine E-Mail Adresse gefunde wurde wird
'eine E-Mail vorbereitet:
If Trim(sTemp) "" Then
Set oAppOutlook = CreateObject("Outlook.Application")
With oAppOutlook.CreateItem(0)
.To = sTemp 'Unser E-Mail Empfänger String aus sTemp
.Cc = sTemp2 'unsere E-Mail Empfänger String aus sTemp2
.Subject = "Testmail" 'E-Mail Betreffzeile
.HTMLBody = "Text"
.Display 'E-Mail anzeigen
'.Send = Direkt senden
End With
Else
MsgBox "Die gesuchte Abteilung hat keine " & _
"hinterlegten Mitarbeiter oder E-Mail Adressen!"
End If
Set oAppOutlook = Nothing
End Sub
Schöne Grüße,
Hotte1010.