Extraction pièces jointes Outlook via VBA

**roidurif** · 18/12/2009, 16h50

Bonjour,

Je reçois des e-mail dans le quelle il y'a un message et une PJ.

Le message dans le mail dit :

Bonjour,

Le Piece jointe correspond au numéro 50078560

Cordialement

J'ai code ci-dessous qui me permets d'extraire les PJ de mes e-mail pour les enregistrés dans un de mes dossiers.

Ce que je souhaite, c'est comment faire pour :

Lorsque j'extrais la pj, la macro renomme ou rajoute dans le nom du fichier extrait le numéro (ex: 50078560 Fiche.xls)

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
 
Option Explicit
Option Compare Text
 
 
Sub Essai()
    Extraction "DOSSIER TEST", "test@adresse.com"
 
End Sub
 
 
Sub Extraction(NomDossier As String, Expediteur As String)
    Dim olApp As Outlook.Application
    Dim olSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim olInbox As Outlook.MAPIFolder
    Dim olmail As Outlook.MailItem
    Dim pceJointe As Outlook.Attachment
 
    Dim y As Integer, x As Integer
 
 
    Set olApp = New Outlook.Application
    Set olSpace = olApp.GetNamespace("MAPI")
    Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
    Set olFolder = olInbox.Folders(NomDossier)
 
    For Each olmail In olFolder.Items
        If olmail.SenderEmailAddress = Expediteur And _
            Not olmail.Attachments.Count = 0 Then
 
            For y = 1 To olmail.Attachments.Count
                 Set pceJointe = olmail.Attachments(y)
                 x = x + 1
                 pceJointe.SaveAsFile "C:\" & pceJointe
                Set pceJointe = Nothing
            Next y
        End If
    Next olmail
 
End Sub

Merci de votre aide

**aalex_38** · 18/12/2009, 18h07

Bonjour,

Ici tu sauves ta pièce jointe :

Code :

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

pceJointe.SaveAsFile "C:\" & pceJointe

C'est à ce niveau que tu peux changer le nom, ce que tu peux faire :

- Recuperer le numero dans le corps du message
- Enregistrer avec ce numero.

Code :

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

pceJointe.SaveAsFile "C:\" &  "50078560" & " Fiche.xls"

Si tu recupère le numero dans une variable par exemple MonNum, tu peux faire

Code :

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

pceJointe.SaveAsFile "C:\" &  monnum & " Fiche.xls"

**roidurif** · 21/12/2009, 09h42

Bonjour,

Ce que je n'arrive pas à faire, c'est de recuperer le numero dans le corps du message, sachant qu'il change et qu'il commence toujour pas 500 et constitué de 8 chiffres.

Puis ensuite eregistrer ce numéro dans la PJ.

- Enregistrer avec ce numero.

Code :

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

pceJointe.SaveAsFile "C:\" &  "50078560" & " Fiche.xls"

Si tu recupère le numero dans une variable par exemple MonNum, tu peux faire

Code :

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

pceJointe.SaveAsFile "C:\" &  monnum & " Fiche.xls"

J'esperes avoir été claire.

Merci de votre aide

**aalex_38** · 21/12/2009, 10h43

Bonjour,

Ce que je n'arrive pas à faire, c'est de recuperer le numero dans le corps du message, sachant qu'il change et qu'il commence toujour pas 500 et constitué de 8 chiffres.

Dans le corps du message, je propose un code comme ça à adapter :

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
 
For Each olmail In olFolder.Items
        If olmail.SenderEmailAddress = Expediteur And _
            Not olmail.Attachments.Count = 0 Then
 
            For y = 1 To olmail.Attachments.Count
                 Set pceJointe = olmail.Attachments(y)
                 x = x + 1
                 pceJointe.SaveAsFile "C:\" & pceJointe
                Set pceJointe = Nothing
            Next y
        End If
 
        ' Recherche de 500 dans le corps du message
        Dim MonBody As String, MonNum As String
        MonBody = olmail.Body
 
        On Error Resume Next
        MonNum = Mid(MonBody, InStr(1, MonBody, "500"), 8)
        On Error GoTo 0
 
        If MonNum = Empty Then
            MsgBox "Numéro 500 non trouvé"
        Else
                If IsNumeric(MonNum) Then
                    MsgBox "ok c'est un num : " & MonNum
                Else
                    MsgBox "ko, c'est pas un num : :" & MonNum
                End If
        End If
 
 
    Next olmail

**roidurif** · 21/12/2009, 13h00

Merci aalex_38,

J'ai adapté la macro par rapport à mon souhait, cela fonctionne si je dit : Recherche de 5007 dans le corps du message, mais par contre si je dit : Recherche de 500 dans le corps du message ca ne trouve pas.

Je ne sais pas si je dois dire :

Code :

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

1
2
 
MonNum = Mid(MonBody, InStr(1, MonBody, "5007"), 8) Or Mid(MonBody, InStr(1, MonBody, "5008"), 8)

ou faut-il revoir le code pour rechercher tout numéro commencant par "500 dans le corps du message"??

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
 
Sub Extraction(NomDossier As String, Expediteur As String)
    Dim olApp As Outlook.Application
    Dim olSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim OLinbox As Outlook.MAPIFolder
    Dim olmail As Outlook.MailItem
    Dim pceJointe As Outlook.Attachment
    Dim MonBody As String, MonNum As String
    Dim y As Integer, x As Integer
    Dim nom As Variant
 
    Set olApp = New Outlook.Application
    Set olSpace = olApp.GetNamespace("MAPI")
    Set OLinbox = olSpace.GetDefaultFolder(olFolderInbox)
    Set olFolder = OLinbox.Folders(NomDossier)
 
 
For Each olmail In olFolder.Items
        If olmail.SenderEmailAddress = Expediteur And _
            Not olmail.Attachments.Count = 0 Then
 
            For y = 1 To olmail.Attachments.Count
                 Set pceJointe = olmail.Attachments(y)
                 x = x + 1
 
 
        ' Recherche de 500 dans le corps du message
        MonBody = olmail.Body
 
        On Error Resume Next
        MonNum = Mid(MonBody, InStr(1, MonBody, "5007"), 8) 'Or Mid(MonBody, InStr(1, MonBody, "5008"), 8)
        On Error GoTo 0
                If MonNum = Empty Then
            MsgBox "Numéro 5007 non trouvé"
        Else
                If IsNumeric(MonNum) Then
                    MsgBox "ok c'est un num : " & MonNum
                pceJointe.SaveAsFile "C:\" & MonNum & "-" & pceJointe
                Set pceJointe = Nothing
 
                Else
                    MsgBox "ko, c'est pas un num : :" & MonNum
                End If
        End If
 
            Next y
        End If
 
 
    Next olmail
 
 
End Sub

Merci de votre aide

**aalex_38** · 21/12/2009, 13h54

J'ai adapté la macro par rapport à mon souhait, cela fonctionne si je dit : Recherche de 5007 dans le corps du message, mais par contre si je dit : Recherche de 500 dans le corps du message ca ne trouve pas.

Je ne comprend pas, s'il trouve 5007 a fortiori il doit trouver 500 !

**roidurif** · 21/12/2009, 14h46

C'est ce que je ne comprend pas !!

Dans le corps du mail il est indiqué 50071811 et il m'affiche le message KO! 500129B2, je ne sais pas où il trouve ce numéro, car il exite nul part.

Et quand je mets 5007, cela fonctionne!!

**aalex_38** · 21/12/2009, 14h53

c'est étrange en effet, peut être peux-tu ajouter dans le code :

Code :

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

Debug.Print MonBody

et voir si eventuellement il te ressort ce numéro dans la fenêtre execution

**roidurif** · 21/12/2009, 15h16

En regardant dans la fenetre d'excution, je vois des lignes qu'il n y a pas dans le mail.

Voici la ligne coupable,

"/C125730F002F0684/38D46BF5E8F08834852564B500129B2C/5D43E74D95F6416CC125768E002EC1E4

J'avais pas vu cette difficulté

J'ai pensé à mettre un espace avant 500, pour etre sur qu'il prenne mon numéro commencant 500

Code :

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

1
2
 
MonNum = Mid(MonBody, InStr(1, MonBody, " 500"), 9)

Mais malheureusement je ne veux pas cette espace blanc dans le nom de mon fichier.

Merci de l'aide

**aalex_38** · 21/12/2009, 15h34

J'ai pensé à mettre un espace avant 500, pour etre sur qu'il prenne mon numéro commencant 500

très bonne idée

Mais malheureusement je ne veux pas cette espace blanc dans le nom de mon fichier.

Regarde l'aide sur la fonction MID, tu devrai t'en sortir, sinon je te donnerai la solution avec plaisir !

**roidurif** · 21/12/2009, 16h10

Je pense être proche du but, mais il doit manquer qq chose

La fonction est celle-ci:
Mid( text, start_position, number_of_characters )

Text : _500
start_position : 2
number_of_characters :8

Code :

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

1
2
 
MonNum = Mid((InStr(MonBody, " 500")), 2, 8)

Merci

**aalex_38** · 21/12/2009, 16h49

Adapté au code ça donne :

Code :

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

MonNum = Mid(MonBody, InStr(1, MonBody, " 500") + 1, 8)

**roidurif** · 21/12/2009, 20h36

Merci infieniment pour ton aide aalex_38,

Je rencontre à nouveau une difficulté, mais je ne sais pas s'il est possible de la résoudre.

il m'arrive d'avoir des mails avec en signature des logos "jpg" et des documents (xls) zipé.

Tu sais s'il est possible d'extraire uniquement les PJ en .xls ou zipé ?

et décompréssé un document (xls) zipé, puis le nommé avec le num 500 ?

Merci de ton aide

**aalex_38** · 22/12/2009, 09h56

Bonjour,

Si ton premier sujet est résolu, je te propose d'ouvrir une nouvelle discussion.

En ce qui concerne les fichiers zippés je ne connais pas bien les procédures, je suppose que l'on doit pouvoir trouver des exemples sur le web.

Alex

Extraction pièces jointes Outlook via VBA

Macros et VBA Excel

Discussions similaires

Partager

Partager