Email Ergänzing, Adresse CC

Sub Serien_EMail_mit_Anhang()
Dim oOut As Object, oMail As Object
Dim objWS As Worksheet
Dim lngRow As Long
Dim strAdressen As String, AktBlatt As String, strPath As String, strFile As String,  _
strFilename As String
On Error GoTo ErrExit
GMS
Set objWS = ThisWorkbook.Sheets("Mail Adressen")   'Tabelle mit den Mailadressen
' Alle Zeilen abarbeiten
For lngRow = 2 To objWS.Cells(Rows.Count, 1).End(xlUp).Row
If InStr(1, objWS.Cells(lngRow, 1), "@") > 0 Then
strAdressen = strAdressen & objWS.Cells(lngRow, 1) & ";"
End If
Next
If Len(strAdressen) > 0 Then
'Temporäre Date erstellen
AktBlatt = ActiveSheet.Name
strFile = ActiveWorkbook.Name
strPath = ActiveWorkbook.Path
' TEMP-Dateiname festlegen
strFilename = strPath & Application.PathSeparator & AktBlatt & ".xls"
Sheets(AktBlatt).Copy
With ActiveSheet
.Cells.Copy
.Range("A1").PasteSpecial Paste:=xlValues
.Range("A1").PasteSpecial Paste:=xlFormats
.Shapes.SelectAll
Selection.Delete
End With
' Datei speichern
ActiveWorkbook.SaveAs Filename:=strFilename
' TEMP-Datei schließen
ActiveWorkbook.Close True
strAdressen = Left(strAdressen, Len(strAdressen) - 1)
Set oOut = CreateObject("Outlook.Application")
Set oMail = oOut.CreateItem(0)
With oMail
' Betreff
.Subject = "Information"
' Text in der oMail
.Body = "Sehr geehrte Damen und Herren," & Chr(13) & Chr(13) & _
"dies ist eine automatisch generierte E-Mail." & Chr(13) & _
Chr(13) & "Viele Grüße " & Chr(13) & _
Environ("Username") & Chr(13)
' Empfängeradresse(n)
.To = strAdressen
.CC = "" ' Auf Wunsch: Kopieempfänger
.BCC = "" ' Auf Wunsch: Blanko-Kopieempfänger
' Datei-Anhang:
.Attachments.Add strFilename
'.Send ' Mail wird sofort verschickt
.Display ' Alternativ: Mail erstmal anzeigen
End With
End If
ErrExit:
GMS True
Kill strFilename
Set oOut = Nothing
Set oMail = Nothing
Set objWS = Nothing
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Modus Then
.Calculation = lngCalc
Else
lngCalc = .Calculation
End If
.Cursor = IIf(Modus, -4143, 2)
.CutCopyMode = False
End With
End Sub

Grüße
Kare