Tabellenbereich als email (Code funktioniert nicht

Sub EmailLevelfile()
    Dim OutApp As Object, Mail As Object, i
    Dim Nachricht
    Dim ClpObj As DataObject

    For i = 1 To 10
        Set ClpObj = New DataObject
        Set OutApp = CreateObject("Outlook.Application")
        Set Nachricht = OutApp.CreateItem(0)
       
        Range("o1:w118").Select
        Selection.Copy

        With Nachricht
            .Subject = "New Order" & Date
            .To = "name@provider.de"
            .cc = "name@provider.de"
           
            ClpObj.GetFromClipboard
            .Body = ClpObj.GetText(1)
            
            .Display
            
            'mail.Send

        End With

        Set OutApp = Nothing
        Set Nachricht = Nothing
        
        Application.Wait (Now + TimeValue("0:00:05"))

    Next i
End Sub