Excel - Mail an mehrere Absender

Sub SendRange()
'Sheets("Tabelle1").Unprotect Password:="198969"
Dim strMailaddresses As String
With Worksheets("Tabelle1") ' Anpassen !!!
strMailaddresses = Join(Application.Transpose(.Range( _
.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value), ";")
End With
'Dimensionen
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim oFSObj As Object, oFSTextStream As Object
Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As String
'Hier wird der Bereich festgelegt
On Error Resume Next
Set rngeSend = Sheets("Tabelle1").Range("A2:D15")
If rngeSend Is Nothing Then Exit 

Sub 'User pressed Cancel
On Error GoTo 0
'Pfad für temporäre Datei
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\XLRange.htm"
'Hier wird die HTML-Datei erstellt
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True
'Outlook session öffnen
Set oOutlookApp = CreateObject("Outlook.Application")
'Neue email
Set oOutlookMessage = oOutlookApp.CreateItem(0)
For i = 1 To 1 'Für einen Serienbrief muss hier der zweite um die jeweilige Briefanzahl erhöht   _
_
werden.
oOutlookMessage.To = SstrMailaddresses
'oOutlookMessage.Cc = Sheets("Tabelle1").Cells(i, 3) 'Kopieempfänger
oOutlookMessage.Subject = Sheets("Tabelle1").Cells(i, 2) 'Betreffzeile
'Die HTML-Datei wird geöffnet mit FilesystemObject
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, 1)
' HTMLBody
strHTMLBody = oFSTextStream.readall
'Normalerweise wird der Body zentriert. Hier wird er linksbündig geschrieben
strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", , , vbTextCompare)
'Für eventuelle Dateianhänge
'oOutlookMessage.Attachments.Add "c:\config.sys"
oOutlookMessage.HTMLBody = strHTMLBody
oOutlookMessage.Display
Next i
'Sheets("E-Mail").Protect Password:="198969"
End Sub




Vielen Dank & freundliche Grüße,

Nico