Codeanpassung EXCEL 3 --> EXCEL 7

Sub Mailversand()
Dim strPath As String, strFile As String
Dim strMitgl(1 To 20) As String, strAnr(20) As String, strEml(20) As String
Dim strsh20 As String, strsh21 As String, strsh22 As String
Dim ii As Integer, jj As Integer, i As Integer
Dim lngFILEFormat As XlFileFormat
With Sheets("Mails")
For ii = 1 To 13 '''''''''' Anpassung erforderlich  !!!!!!!!!!!!!!!!!!!!
strMitgl(ii) = .Cells(ii, 1)
strAnr(ii) = .Cells(ii, 2)
strEml(ii) = .Cells(ii, 3)
Next ii
End With
strsh20 = "Zentrale"
strsh21 = "AlleSpielerV75"
For ii = 1 To 13    '''''''''' Anpassung erforderlich  !!!!!!!!!!!!!!!!!!!!
Application.ScreenUpdating = False
Sheets(Array(strMitgl(ii), strsh20, strsh21)).Copy ' 4 Sheets werden ausgewählt
For jj = 1 To Sheets.Count
Sheets(jj).Activate
Call Verknuepfungen_löschen
Next jj
Application.CutCopyMode = False
strPath = "C:\Windows\Temp\"
strFile = strPath & strMitgl(ii) & ".xls"
If Application.Version > "11.0" Then
lngFILEFormat = 56
Else
lngFILEFormat = 43
End If
With ActiveWorkbook
.SaveAs strFile, lngFILEFormat
'         Senden strFile, strAnr(ii), strEml(ii)  ' mit 3 Parametern
Excel_Serial_Mail2 strFile, strAnr(ii), strEml(ii)  ' mit 3 Parametern
.Close
End With
Kill strFile 'Datei löschen
Next ii
Application.ScreenUpdating = True
End Sub

Sub Verknuepfungen_löschen()
On Error GoTo Errorhandler
Do
Cells.Find(What:=".XLS", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Loop
Errorhandler:
End Sub

Sub Excel_Serial_Mail2(AWS As String, Anred As String, Mailadr As String)
Dim MyOutApp As Object, MyMessage As Object, Sheets As Object   ', AWS As String
Dim i As Long
'Start der Sendeschleife an .. Empfänger
'    For i = 1 To 3
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Die Empfänger stehen in Spalte A ab Zeile 1
.To = Mailadr  'E-Mail Adresse
'Der Betreff in Spalte B
.Subject = "Aktuelle Abrechnungsübersicht V75 TG" '"Betreffzeile"
.Attachments.Add AWS
'Der zu sendende Text in Spalte C
'Maximal 1024 Zeichen
'Der Text wird ohne Formatierung übernommen
.Body = "Hallo " & Anred & "," _
& vbCrLf & vbCrLf & "anbei die aktuellste Abrechnungsübersicht." _
& vbCrLf & vbCrLf & "mfg Markus Jasper (Jaz)"
'Hier wird die Mail angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
.Send
End With
'Objectvariablen leeren
Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
'Sendepause einschalten
'Outlook kann die Aufträge nicht schnell genug verarbeiten
Application.Wait (Now + TimeValue("0:00:05"))
'    Next i
End Sub