1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
| Dim sData1 As String
Dim arrData1() As String
Dim i As Long
sData1 = TextBox.Value
arrData1 = Split(sData1, Chr(10))
'Déclarations
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim mapDossier As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
'Instancies
Set olApp = Outlook.Application
Set mapDossier = olApp.GetNamespace("MAPI").Folders("Boîte aux lettres - Special").Folders("Inbox")
MsgBox "Total Items: " & mapDossier.Items.Count
Set myDestFolder = mapDossier.Folders("1- DOSSIER Novembre").Folders("PLANNING")
'Boucle parcourant les Emails de la boîte de réception
For i = 0 To UBound(arrData1)
arrData1(i) = Trim(arrData1(i))
arrData2 = Split(arrData1(i), Chr(13))
'MsgBox "-" & arrData2(0) & "-"
For Each olMail In mapDossier.Items
With olMail
'basic info about message
If (.Subject = arrData2(0) And .SenderName = "PLATON-noreply@sfr.com") Then
MsgBox "move de : " & arrData2(0) & "FROM : " & .Subject & .SenderName
.Move (myDestFolder)
End If
End With
DoEvents
Next olMail
Next
'Affichage du résultat
MsgBox "CA MARCHE"
End |
Partager