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

[Tresor1]

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

 

[danielco]

Bonjour,

Enlève la ligne :

On Error Resume Next

et dis quelle est la ligne en erreur.

Cordialement.

Daniel

 

[Tresor1]

Bonjour ,
A la base le code ne signale aucun probleme mais lorsque j enleve la ligne " on Error Resume Next " il survient une erreur du genre cette ligne n est pas au bon endroit " x3 = Left(x2(1), 4) ". le code fonctionne normalement sauf qu il n execute pas ce qui lui est demander a partir d ici: Dim subFolder As outlook.MAPIFolder, ImpMail

 

[Tresor1]

Bonjour,
ya t il personne pour m aider?s il vous plait je ne me retrouve pas.

 

[xUpsilon]

Bonjour

Simple indication au passage, le principe de la ligne "On error Resume Next" est précisément de ne pas afficher les erreurs. Donc pas de surprise à ce que le code "ne signale pas de problème" quand la ligne "On error Resume Next" est présente 😉

Bonne continuation