Neues Outlook Makro funktioniert nicht mehr

Private Sub CommandButton1_Click()

'Updated by Extendoffice 2017/9/14

    Dim xOutApp As Object

    Dim xOutMail As Object

    Dim xMailBody As String

    On Error Resume Next

    Set xOutApp = CreateObject("Outlook.Application")

    Set xOutMail = xOutApp.CreateItem(0)

    xMailBody = "Hallo zusammen" & vbNewLine & vbNewLine & _

              "Beispiel Text" & vbNewLine & vbNewLine & _

              "Beste Grüsse"

        

                  On Error Resume Next

    With xOutMail

        .To = "beispiel@beispiel.com"

        .CC = ""

        .BCC = ""

        .Subject = "Rückschub: Materialien eingetragen"

        .Body = xMailBody

        .Display   'or use .Send

    End With

    On Error GoTo 0

    Set xOutMail = Nothing

    Set xOutApp = Nothing

End Sub