Discussion :

[MCMarie]

Bonjour à tous,

Tous les jours je reçois sur une boite mail des informations à collecter.
Dans chaque mail j'ai toujours les même informations :
- la date / numéro / infos 1 / infos 2

Je souhaiterais par une macro récupérer ces infos et les mettre dans un fichier excel exemple :
Colonne A - la date
Colonne B - numéro
Colonne C - infos 1
Colonne D - infos 2

j'ai trouvé sur internet une macro qui correspondrait à mon besoin ( et également sur ce forum mais qui ne correspond pas à ce que je cherche à faire), je l'ai modifiée mais il ne se passe rien quand je la lance ... je n'arrive pas à voir mon erreur ou ce qu'il manque.

Si quelqu'un peut m'apporter son aide ?
Je vous mets en PJ le fichier avec la macro et le modèle du mail.

En vous remerciant par avance,

Test Counter.xlsm
mail test.txt

[mfoxy]

Bonjour Marie,

Pourriezgvous déposer votre code actuel, entre balise, peu de membre ouvrent les fichiers joint pour des raisons de sécuritéss (cfr charte du forum).

Vous trouverez ainsi plus vite de l'aide 😉

Bav,
MFoxy

[MCMarie]

Bonjour,

Merci de votre réponse, je n'y avait pas pensé pour le fichier

voici le code en question,

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
44
45
46
47
48
49
50
51
52
53
54
55
Sub Counter()
 
 
Dim olapp As New Outlook.Application
Dim NS As Object, Dossier As Object
Dim OlExp As Object
Dim i As Object
Dim mybody() As String
Dim fromsender As String
 
Set NS = olapp.GetNamespace("MAPI")
Set Dossier = NS.Folders("Mail Counter").Folders("Boîte de réception")
b = 2
For Each i In Dossier.Items
 
    If i.SenderEmailAddress = "compteur@unys.com" And i.Subject = "Counter List" Then
        sujet = i.Subject
        mybody = Split(i.Body, vbCrLf)
        fromsender = i.SenderEmailAddress
        dejafait = True
        For compt = 0 To UBound(mybody)
            If InStr(1, UCase(mybody(compt)), UCase("[Serial Number],")) > 0 And dejafait = True Then
                Serial = LTrim(Split(mybody(compt), ",")(1))
                dejafait = False
            End If
 
 
            If InStr(1, UCase(mybody(compt)), UCase("[Total Color Counter]")) > 0 Then
                CColor = LTrim(Split(mybody(compt), ",")(1))
 
            End If
 
            If InStr(1, UCase(mybody(compt)), UCase("[Total Black Counter]")) > 0 Then
                CBlack = LTrim(Split(mybody(compt), ",")(1))
 
            End If
 
            If InStr(1, UCase(mybody(compt)), UCase("[Send Date]")) > 0 Then
                mydate = LTrim(Split(mybody(compt), ",")(1))
 
            End If
 
        Next
        Cells(b, 1) = Format(mydate, "MM/DD/YYYY")
        Cells(b, 2) = Serial
        Cells(b, 3) = CColor
        Cells(b, 4) = CBlack
 
 
     b = b + 1
 
  End If
 
Next i
End Sub

Merci par avance de votre aide,