export von excel nach Teams

Sub ToDoOutlook()
'Variablen deklarieren.
Dim Zeile As Long
Dim ZeileMax As Long
Dim appOutLook As Outlook.Application
Dim taskOutLook As Outlook.TaskItem
Dim NameUser As String
Dim Name As String
Name = Environ("Username")
If UCase(Name)  "Mein Name" Then '"UCase" ignoriert Groß- und Kleinschreibung
Exit Sub
Else
Application.EnableEvents = False
With Worksheets("Tabelle1")
ZeileMax = Cells(Rows.Count, 1).End(xlUp).Row
For Zeile = 2 To ZeileMax
If .Cells(Zeile, 4).Value Like "*" & "Meine Initialen" & "*" Then
'wenn in der jeweiligen Zeile der Spalte D meine Initialen vorkommen wird mir    _
_
_
_
_
die Aufgabe          zugewiesen
'Verbindung zu Outlook herstellen.
Set appOutLook = CreateObject("Outlook.Application")
'Ankündigen, dass eine Aufgabe erstellt werden soll.
Set taskOutLook = appOutLook.CreateItem(olTaskItem)
With taskOutLook
'Betreff einfügen.
.Subject = Worksheets("Tabelle1").Cells(Zeile, 3)
'Text für die Aufgabe eintragen.
.Body = Worksheets("Tabelle1").Cells(Zeile, 17)
'Aufgabe speichern.
.Save
'Aufgabe öffnen.
End With
'Nächste Zeile der gleichen Spalte auswählen
ActiveCell.Offset(1, 0).Select
' Verbindung zu Outlook trennen
Set taskOutLook = Nothing
Set appOutLook = Nothing
End If
Next Zeile
'    Unload ToDo
'    MsgBox "Alle Aufgaben wurden in Outlook eingetragen!"
End With
End If
End Sub