Discussion :

[clambsf]

La fenêtre d’exécution indique 0 messages dans la conversation.
Pourtant, il y en a deux

j'ai l'impression que c'est set oconv = omail.getconversation qui ne marche pas.

[Oliv-]

Tu as le même chiffre ne #1 et #2 ?

[clambsf]

#1 nb de mail de la conversation= 0
#2 nb de mail de la conversation= 0

[Oliv-]

Alors essaye ce code indépendemment de tous les autres, dans un nouveau module par exemple. et test avec un email ouvert

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
39
40
41
42
43
Private Sub Test_Conversation()
 
    Dim oMail As Outlook.MailItem
    ' Obtain the current item for the active inspector.
    Set oMail = Application.ActiveInspector.CurrentItem
 
    Debug.Print "Email =" & oMail.subject
    Debug.Print "oMail class=" & oMail.Class
    MsgBox oMail.subject
    Dim oConv As Outlook.Conversation
    Dim oTable As Outlook.Table
    Dim oRow As Outlook.Row
    Dim oItem As Outlook.MailItem
    Const PR_STORE_ENTRYID As String = _
          "http://schemas.microsoft.com/mapi/proptag/0x0FFB0102"
 
    'On Error Resume Next
    Debug.Print "oMail Is Nothing=" & (oMail Is Nothing)
    If Not (oMail Is Nothing) Then
        ' Obtain the Conversation object.
        Set oConv = oMail.GetConversation
        On Error Resume Next
        Debug.Print oConv.ConversationID
        On Error GoTo 0
        Debug.Print "oConv Is Nothing=" & (oConv Is Nothing)
        If Not (oConv Is Nothing) Then
            Set oTable = oConv.GetTable
            Debug.Print "#1# nb de mail de la conversation=" & vbTab & oTable.GetRowCount
            oTable.Columns.add (PR_STORE_ENTRYID)
            Debug.Print "#2# nb de mail de la conversation=" & vbTab & oTable.GetRowCount
            Do Until oTable.EndOfTable
                Set oRow = oTable.GetNextRow
                ' Use EntryID and StoreID to open the item.
                Set oItem = Application.Session.GetItemFromID( _
                            oRow("EntryID"), _
                            oRow.BinaryToString(PR_STORE_ENTRYID))
                Debug.Print oItem.EntryID & vbTab & oItem.subject & vbTab & oItem.ReceivedTime
            Loop
            Else
            Debug.Print "pas une conversation"
        End If
    End If
End Sub

[clambsf]

Avec Set oMail = Application.ActiveInspector.CurrentItem j'ai le message variable non defini ou bloc with...
Que dois-je rajouter ?

[clambsf]

Salut,

voila j'ai fait un test mail ouvert
Ci-dessous fenêtre d'éxécution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Email =TR: QARMA Laith - Flux en provenance d'IRAN ayant transité par la TURQUIE
oMail class=43
oMail Is Nothing=Faux
9F800B7AB69A49E6B498A561DD37CA75
oConv Is Nothing=Faux
#1# nb de mail de la conversation=  0
#2# nb de mail de la conversation=  0

Et même problème avec Do Until oTable.EndOfTable

[Oliv-]

Salut,
As tu essayé sur plusieurs Emails, est ce qu'ils font tous cela ? où y a t'il une particularité dans celui-ci ?

De quel type de compte s'agit t'il un compte Exchange ?

Comment es tu connecté ? est cnoté en bas à droite de outlook : "Connecté à Microsoft Exchange" ou "En ligne avec Microsoft Exchange" ?

Essaye de m'envoyer le mail en question, en faisant fichier/enregistrer-sous type .msg et tu le met sur https://www.wetransfer.com/ et tu m'envois le lien par MP

[clambsf]

J'ai du mal à comprendre je l'ai fait sur plusieurs mails seuls ouverst et fermés ou au sein d'une conversation avec le même résultat négatif

Et puis je recommence dans un autre répertoire et le code se déroule.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
            Do Until oTable.EndOfTable
                Set oRow = oTable.GetNextRow
                ' Use EntryID and StoreID to open the item.
                Set oItem = Application.Session.GetItemFromID( _
                            oRow("EntryID"), _
                            oRow.BinaryToString(PR_STORE_ENTRYID))
                Debug.Print oItem.EntryID & vbTab & oItem.Subject & vbTab & oItem.ReceivedTime
            Loop
            Else
            Debug.Print "pas une conversation"
        End If

Dans tous les cas, le code va jusqu'au premier loop, ensuite il retourne à do until et va directe sur end if.
C'est déjà un premier pas mais en cas de conversation avec plusieurs mails, on passe à coté

Fenêtre d'éxécution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Email =LAITERIE DE MONTAIGU - IRAQ
oMail class=43
oMail Is Nothing=Faux
62437B77E6EA42F9A07B484F70893EE6
oConv Is Nothing=Faux
#1# nb de mail de la conversation=  1
 
Je suis sur Microsoft exchange et en ligne avec le serveur
#2# nb de mail de la conversation=  1
00000000DAE0C8522AEAD511910200805F19606007002BA468DCAEF62B47AA7115F61C44F1A4007ADD40001100002BA468DCAEF62B47AA7115F61C44F1A4007ADD4035630000    TR: LAITERIE DE MONTAIGU - IRAQ 12/01/2016 11:35:54

[Oliv-]

Alors j'ai réussi à reproduire ce cas avec une bal "en ligne"



apparemment le mode est "en ligne" quand la boite supplémentaire est paramétrée là





Cela fonctionne dans ces modes là


ça ce serait quand on ajoute une seconde boite


et bien sûr le mode Exchange mis en cache.




As tu la possibilité d'ajouter un compte Exchange ?

[Oliv-]

Je te confirme qu'en ajoutant la bal comme un nouveau compte de messagerie, j'obtiens bien la conversation complète !

Je comprends pas bien la différence...

[clambsf]

Dans les boites avec lesquelles je veux faire cette macro, je suis en ligne

[Oliv-]

C'est effectivement le problème , elles devraient être "En ligne avec Microsoft Exchange"

[clambsf]

Et ça, je ne pourrais pas le changer, je n'ai pas la main la-dessus.
Du coup, j'abandonne la gestion de la conversation et je vais gérer les mails un par un, save & move

Dans ce code la, la modif à faire est-elle la suivante :

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
39
Sub ProcessThisItem(objitem As Object)
'---------------------------------------------------------------------------------------
' Procedure : ProcessThisItem
' Author    : Oliv
' Date      : 12/02/2016
' Purpose   :
'---------------------------------------------------------------------------------------
    Dim Nomdossier
    Dim OL As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim BTR As Outlook.MAPIFolder
    
    Dim FolderToMove As Outlook.Folder
    Dim oMail As Outlook.MailItem

    '
    If objitem.Class = olMail Then
        Dim mymail As Outlook.MailItem
        Set mymail = objitem
        Nomdossier = mymail.Parent.Name

        If InStr(1, mymail.Body, "libéré", vbTextCompare) Or InStr(1, mymail.Body, "annulé", vbTextCompare) Or InStr(1, mymail.Body, "libération", vbTextCompare) Or InStr(1, mymail.Body, "released", vbTextCompare) Or InStr(1, mymail.Body, "annulation", vbTextCompare) Then
            If mymail.CreationTime < DateAdd("d", -60, Date) Then
                Call SaveAndMoveConversation(mymail, Bckup, "O:\Projets01\DDC-CC\EMBARGO\" & Nomdossier & "\2016") 'à supprimer
                Call SavAs_mail_as_msg(oItem, repertoire) 'à la place
                '            Set OL = Outlook.Application
                '            Set olNS = OL.GetNamespace("MAPI")
                '            Set olFolder = olNS.Folders("EMBARGO Securite-Financiere")
                '            Set BTR = olFolder.Folders("Boîte de réception")
                '            Set Bckup = BTR.Folders("Bckup Macro")

                '            Call MoveConversation(mymail, Bckup)
                '            mymail.Move Bckup

            End If
        End If
    End If
End Sub

Et dans celui-la, tout à la fin

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
39
40
41
42
ub SavAs_mail_as_msg(mymail As Outlook.MailItem, repertoire)
'---------------------------------------------------------------------------------------
' Procedure : SavAs_mail_as_msg
' Author    : Oliv
' Date      : 12/02/2016
' Purpose   :
'---------------------------------------------------------------------------------------
'
' exemple repertoire = "c:\mail\"
    Dim NomExport
    Dim PathNomExport
    Dim n
    Dim MemPath

    'Ici on construit le nom du fichier qui sera créé
    NomExport = mymail.Subject
    ' & mymail.CreationTime

    'Ici on vérifie le répertoire où l'enregistrer
    If Right(repertoire, 1) <> "\" Then repertoire = repertoire & "\"
    
    'on vérifie s'il existe sinon on le crée
    Module10.waaps_creedir (repertoire)

    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
                                                                                                                              NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"

    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        'MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        n = n + 1
    Wend

    mymail.SaveAs PathNomExport, OlSaveAsType.olMSG
    Call ModifDate(CStr(PathNomExport), mymail.CreationTime, 4)
    Call refresh_explorer(PathNomExport)
   oItem.Move FolderToMove
End Sub

[Oliv-]

C'est le code avant qu'on parle de conversation !

Sinon on peut garder les conversations (pour quand ca marche)

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
39
40
41
42
43
Sub SaveAndMoveConversation(oMail As Outlook.MailItem, FolderToMove As Outlook.Folder, repertoire)
 
'---------------------------------------------------------------------------------------
' Procedure : Save and MoveConversation
' Author    : Oliv
' Date      : 18/02/2016
' Purpose   : Enreigistre la conversation sur Disque puis la déplace dans un dossier outlook
'---------------------------------------------------------------------------------------
'
    Dim oConv As Outlook.Conversation
    Dim oTable As Outlook.Table
    Dim oRow As Outlook.Row
    Dim oItem As Outlook.MailItem
    Const PR_STORE_ENTRYID As String = _
          "http://schemas.microsoft.com/mapi/proptag/0x0FFB0102"
 
    On Error Resume Next
 
    If Not (oMail Is Nothing) Then
        ' Obtain the Conversation object.
        Set oConv = oMail.GetConversation
        If Not (oConv Is Nothing) Then
            Set oTable = oConv.GetTable
            oTable.Columns.add (PR_STORE_ENTRYID)
            Debug.Print oTable.GetRowCount
if oTable.GetRowCount =0 then goto marchepas
            Do Until oTable.EndOfTable
                Set oRow = oTable.GetNextRow
                ' Use EntryID and StoreID to open the item.
                Set oItem = Application.Session.GetItemFromID( _
                            oRow("EntryID"), _
                            oRow.BinaryToString(PR_STORE_ENTRYID))
                Call SavAs_mail_as_msg(oItem, repertoire)
                oItem.Move FolderToMove
            Loop
        Else

:marchepas
            Call SavAs_mail_as_msg(oMail, repertoire)
            oMail.Move FolderToMove
        End If
    End If
End Sub

[clambsf]

Merci, je vais essayer de mi retrouver car j'ai fait les modifs dessus au fur et à mesure.
En tout cas oui je garde tout ce qui concerne la conversation pour le jour où...

Merci encore pour toute ton aide

[rgccx]

Un grand merci à Oliv', grâce à ce fil j'ai pu faire ce que je voulais