Bonjour à tous,

je suis en train de chercher à récupérer le corps des mails Outlook 2010 (alerte virus officescan) vers excel 2010 pour traitement.
puis de déplacer le mail dans un dossier (outlook) "traiter"
je suis également à la recherche du code qui pourrait activer une couleur dans la colonne catégorie du mail (pour montrer quel admin l'a traité).

j'ai trouvé un code qui marche plutôt bien lorsque la boite mail est celle par défaut ...

mais dans mon cas la boite mail est une boite supplémentaire (boite "fonctionnel" avec d'autres admin).
Je n'arrive pas à trouver le bon code pour indiquer le dossier de cette boite qui n'est pas celle par défaut. j'ai tenté quelques pirouettes avec l'adresse mail dans le code
(pour l'exemple je l'ai remplacé par adressemaildelaboite@domaine.fr).
j'ai mis en commentaire certaines lignes pour mes différentes essais

merci par avance pour votre aide.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
Sub LireMessagesDUnDossierEtLeDeplacerVersUnAutre()
    Dim olApp As Object, NS As Object, Dossier As Object
    Dim DossierDest As Object, DossierCible As Object
 
    Dim i As Object, x As Long, R As Object, Ligne As Long
 
    Set olApp = CreateObject("Outlook.Application")
    Set NS = olApp.GetNamespace("MAPI")
 
    ' Set Items = GetFolderPath("adressemaildelaboite@domaine.fr\Boîte de réception").Items
    ' Set Inbox = NS.GetDefaultFolder(olFolderInbox)
 
    Set inbox = NS.GetDefaultFolder(olFolderInbox) ' NS.getFolders("adressemaildelaboite@domaine.fr").Folders(targetFolder)
    'Set inbox = GetFolderPath("adressemaildelaboite@domaine.fr\Boîte de réception")(olFolderInbox)
 
    Set DossierSource = inbox.Folders("essai")
    Set DossierDest = inbox.Folders("traiter")
 
    With Sheets("Feuil1")
        For Each i In DossierSource.Items
            Ligne = Ligne + 1
            .Cells(Ligne, 1) = i.Subject
            Ligne = Ligne + 1
            For x = 0 To UBound(Split(i.Body, vbCrLf))
                Ligne = Ligne + 1
                .Cells(Ligne, 2) = Split(i.Body, vbCrLf)(x)
                .Cells(Ligne + 1, 2) = "fin du msg"
            Next x
            Ligne = Ligne + 1
            .Columns(2).AutoFit
            i.Move DossierDest
        Next i
    End With
    Set NS = Nothing
    Set olApp = Nothing
 
End Sub