Wenn zweite Mail Adresse dann CC

Option Explicit
Private Function IsValidMailAddress(ByVal strAddress As String) As Boolean
Dim oRegExp As Object
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
.Pattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|" & _
"}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:" & _
"[a-z0-9-]*[a-z0-9])?"
.IgnoreCase = True
IsValidMailAddress = .Test(strAddress)
End With
Set oRegExp = Nothing
End Function
Sub Mail()
Dim strRec As String
Dim OutApp, OutMail As Object
Dim Ws As Worksheet: Set Ws = Workbooks("Test.xlsm").Worksheets("Tabelle1")
If Not IsValidMailAddress(strRec) Then strRec = Ws.Range("Telefon1_Eingabe").Text
If Not IsValidMailAddress(strRec) Then strRec = Ws.Range("Telefon2_Eingabe").Text
If Not IsValidMailAddress(strRec) Then strRec = Ws.Range("Telefon3_Eingabe").Text
If Not IsValidMailAddress(strRec) Then
strRec = InputBox("Bitte Empfängeradresse angeben:", "Mail")
'If strRec Not vbOK Then Then Exit Sub
End If
' Bezug zu Outlook herstellen...
Set OutApp = CreateObject("Outlook.Application")
' ...neue E-Mail erzeugen
Set OutMail = OutApp.CreateItem(0)
' Werte den Eigenschaften zuweisen...
OutMail.To = strRec
OutMail.CC = ""
OutMail.BCC = ""
OutMail.GetInspector.Display
End Sub