Enregistrer des pièces jointes sur un tableau excel

Bonjour, je vais essayer d'aller au plus simple concernant ma question. Bien sur je suis très très novice mais je pense pouvoir y arriver...Dans le cadre de mon taf, je reçois des mails sur Outlook 2016 avec une pj en html qui a toujours le même nom quelque soit les expéditeurs, ces pj comportent des données très utiles pour mon travail. Alors pour les traiter, je dois les copier ou enregistrer sous dans un dossier sur mon disque dur, mon problème est que je dois les enregistrer une par une dans ce dossier en les renommant manuellement pour qu'elles puissent être envoyées sur un tableau excel grâce à une application qu'un de mes collègues m'a créé. Malheureusement pour moi il n'a pas pu trouver l'astuce pour pouvoir enregistrer ces pj automatiquement dans le dossier de traitement vers excel et j'ai actuellement une soixantaine de pj à traiter une fois tout les 15 jours et ce nombre va augmenter de plus en plus...Alors avant de me retrouver séchée devant mon pc ou la tête dans mon clavier entrain de dormir ;), j'essaye de trouver une solution qui je pense doit bien exister...Je vous remercie par avance de l’intérêt que vous porterez à mon cas.

RE QUESTION

Bonsoir,

Pour faire suite à mon post, j'ai pu reprendre le script d'Olivier CATTEAU du 23 avril 2007 dans la rubrique FAQ MS-Outlook "Comment enregistrer les pièces jointes d'un mail sur une règle à la réception d'un mail ?" tout fonctionne mais le hic c'est que mes pj ont toutes le même nom donc du coup, je n'enregistre que 2 pj avec le répertoire old.
Est ce que vous pouvez m'aider à modifier le script par exemple en indiquant que si la pj a le même nom mettre 1 devant, 2, 3... j'ai bien essayé de lui écrire une condition mais comme j'ai indiqué je suis novice et ne parle pas la langue script :D...Ci dessous le script :
Encore merci pour votre aide
Bonne soirée ou bonne journée

Code:

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
Sub script(Mail As MailItem)
 
    MsgBox "Vous venez de recevoir un Mail de " & Mail.SenderName & vbCrLf & "Ayant pour sujet " & Mail.Subject
 
End Sub
 
Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)
 
' ***olivier CATTEAU***
 
' 23 avril 2007
 
    Dim olNS As Outlook.NameSpace
    Dim MyMail As Outlook.MailItem
 
    Dim expediteur
    Set olNS = Application.GetNamespace("MAPI")
    Set MyMail = olNS.GetItemFromID(strID.EntryID)
 
    'MsgBox "nouveau message"
 
    If MyMail.Attachments.Count > 0 Then
 
        expediteur = MyMail.SenderEmailAddress
 
        'on crée le répertoire où mettre les fichiers joints ##########################################################
 
        'c:\temp\pj\ doit déjà exister !!!
 
        Repertoire = "c:\temp\pj\" & expediteur & "\"
 
        If Repertoire <> "" Then
 
            If "" = Dir(Repertoire, vbDirectory) Then
 
                MkDir Repertoire
 
            End If
 
        End If
 
        'on traite les pj
 
        Dim PJ, typeatt
 
        For Each PJ In MyMail.Attachments
            'vérification si c'est une PJ Embedded
 
 
            If typeatt = "" Then
 
                If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then
 
                    MsgBox Repertoire & PJ.FileName & " existe !!"
 
                    'si existe copie vers le répertoire old
 
 
                    If "" = Dir(Repertoire & "old", vbDirectory) Then
 
                        MkDir Repertoire & "old"
 
                    End If
 
                    FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName
 
                End If
 
                PJ.SaveAsFile Repertoire & PJ.FileName
 
            End If
 
        Next PJ
 
        'drapeau vert
 
        MyMail.FlagIcon = olGreenFlagIcon
 
        'Marque lu
 
        MyMail.UnRead = False
 
        MyMail.Save
 
        'on déplace le mail vers un sous dossier outlook
 
        Dim myDestFolder As Outlook.MAPIFolder
 
        Set myDestFolder = MyMail.Parent.Folders("test")
        MyMail.Move myDestFolder
 
    End If
 
    Set MyMail = Nothing
    Set olNS = Nothing
 
Fin:
 
End Sub
 
 
 
' Function: Fields_Selector
 
' Purpose: View type of attachment
 
' olivier catteau fevrier 2006
 
Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant
 
    Dim oSession As MAPI.Session
    ' CDO objects
 
    Dim oMsg As MAPI.Message
    Dim oAttachs As MAPI.Attachments
 
    Dim oAttach As MAPI.Attachment
 
    ' initialize CDO session
 
    On Error Resume Next
 
    Set oSession = CreateObject("MAPI.Session")
    oSession.Logon "", "", False, False
 
    ' get the message created earlier
 
    Set oMsg = oSession.GetMessage(strEntryID)
    ' set properties of the attached graphic that make
 
    ' it embedded and give it an ID for use in an image tag
 
    Set oAttachs = oMsg.Attachments
    Set oAttach = oAttachs.Item(attindex)
    Dim strCID As String
 
    strCID = oAttach.Fields(&H3712001E)
 
    Isembedded = strCID
 
    Set oMsg = Nothing
 
    oSession.Logoff
 
    Set oSession = Nothing
 
End Function

Bonjour,
Tu peux consulter cet article http://www.developpez.net/forums/blo...yperlien-mail/

RE QUESTION

Bonjour,

je vous remercie, mais je n'arrive pas à intégrer le texte pour traiter les pj....
Bonne soirée