XL 2016 Deplacer un E-mail du Outlook dans un autre Dossier du Outlook

Bonjour le Forum,

Mon code lit les E-mail qui se trouvent dans le "ImpMail" dans Excel. maintenant je veux deplacer les emails deja lu du Impmail dans un autre Dossier du Outlook("erledigte Mails") .j ai ecrit un code mais il ne fonctionne pas .pouvez vous me dire a quel niveau se trouve l erreur? le code fonctionne bien mais n excecute pas le deplacement .Merci d avance.

Sub getdatafromOutlook()
Dim OutlookApp As outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim outlookMail As Variant
Dim i As Integer


Set OutlookApp = New outlook.Application

Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Impmail")

i = 3

For Each outlookMail In Folder.Items

Cells(i, 1).Value = outlookMail.ReceivedTime
Cells(i, 1).NumberFormat = "dd.mm.yy"
Cells(i, 2).Value = outlookMail.Subject
Cells(i, 2).Columns.AutoFit
Cells(i, 2) = Replace(Cells(i, 2), "WG: Expired EhP - ", "")
Cells(i, 3).Value = outlookMail.Body

i = i + 1


Next outlookMail

Dim derligne%, x2, x3, ta
On Error Resume Next
derligne = Cells(Rows.Count, 2).End(3).Row
ReDim ta(1 To 1000, 1 To 1)

For i = 2 To derligne
Cells(i, 4) = ""
x2 = Split(Cells(i, 3), "ID: ")
x3 = Left(x2(1), 4)
Cells(i, 3) = x3

Next i

Dim subFolder As outlook.MAPIFolder, ImpMail
Dim Items As outlook.Items

If Items.Class = outlookMail Then
Set subFolder = ImpMail.Folders("erledigte Mails")
Items.UnRead = False
Items.Move subFolder
End If

Set ImpMail = Nothing
Set subFolder = Nothing
Set Items = Nothing

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub