Extraire files d`emails regroupes ds dossier

[VBA_DEAD]

Bonjour le forum

J`ai un probleme tout bete : mais je cherche une macro pour resoudre la chose... et donc c`est peut etre pas si simple

je reçoit 350 emails tous les mois avec pour chaque email un fichier excel dedans (un fichier = 1 client qui reçoit son rapport et je dois recuperer les rapports pour faire tournwer mes autres macros)

j`ai tous mes emails et je cherche a faire la chose suivante :

Disons que je colle mes emails ds un dossier

Je cherche une macro qui me récupère tous les fichiers sans avoir a ouvrir mes emails 1 par 1 (pas couper coller mais copier – coller). Je garde les emails ensuite pour mes records en cas de pb.
Bref si j`ai 350 emails, je me retrouve par macro avec mes 350 fichiers excels visibles ds mon dossier

C`est possible de faire ca ??

merci

VBA_DEAD

 

[MichelXld]

Re : Extraire files d`emails regroupes ds dossier

bonjour

Tu pourras adapter cette procédure qui permet de boucler sur les messages de tous les dossiers Outlook (boite de réception, éléments envoyés, éléments supprimés ... et tous leurs sous dossiers ) pour en extraire les pièces jointes et les enregistrer sur le disque dur.

Option Explicit

'Nécessite d'activer la référence 
'"Microsoft Outlook xx.xx Object Library"

Dim x As Integer
    'La boite de réception , la boite des éléments supprimés et tous leurs
    'sous dossiers sont pris en compte.
     Sub ExportePiecesJointes()
    Dim Ol As New Outlook.Application
    Dim Ns As Outlook.Namespace
    Dim Dossier As Outlook.MAPIFolder
    
    Set Ns = Ol.GetNamespace("MAPI")
    Set Dossier = Ns.Folders(1)
    
    SearchFolders Dossier
    x = 0
End Sub

Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder)
Dim y As Integer
Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim SousDossier As Outlook.MAPIFolder
For Each SousDossier In Fld.Folders
    If SousDossier.DefaultItemType = 0 Then
        For Each OLmail In SousDossier.Items
            If Not OLmail.Attachments.Count = 0 Then
                For y = 1 To OLmail.Attachments.Count
                     Set pceJointe = OLmail.Attachments(y)
                     x = x + 1
                     pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                    Set pceJointe = Nothing
                Next y
            End If
        Next OLmail
    End If
    SearchFolders SousDossier
Next SousDossier
End Sub

Bon après midi
MichelXld

 

[VBA_DEAD]

Re : Extraire files d`emails regroupes ds dossier

Bonsoir Michel XLD,

merci de ton aide.


C`est plus que ce que je cherche.
Moi je colle mes fichiers ds mon file et je cherche juste a recuperer les fichiers excel qui sont ds ces emails specifiques.
mais bon, je vais essayer d`adapter car ca semble bien pratique
Juste une question :
ca veut dire quoi la chose suivante?
Set Ns = Ol.GetNamespace("MAPI")

Et je colle ca ds ma boite outlook??

les emails que je recois viennent d`une adresse email : ReportProcess@xxxx

et le sujet des emails est : "RC - Rapport Client YYY"
Enfin le fichier qui est ds l`email s`appelle toujours "NOM CLIENT - XXXXX - DATE
la macro va capturer les fichiers selon le nom de l`expediteur, le sujet de l`email ou le nom du file? bref c`est la dessous que se definit la chose, non?
Set Ns = Ol.GetNamespace("MAPI")

ou

Outlook.MAPIFolder)

Je voudrais pas recuperer mes 15000 fichiers de ma boite email! LOL


Merci michelXLD

VBA_DEAD

 

[MichelXld]

Re : Extraire files d`emails regroupes ds dossier

bonjour

ca veut dire quoi la chose suivante?
Set Ns = Ol.GetNamespace("MAPI")

GetNamespace("MAPI") permet d'accéder à la base de l'application Outlook pour ensuite en extraire les données, (les pièces jointes des messages dans ton cas).

Et je colle ca ds ma boite outlook??

Non, dans Excel (nous sommes sur un forum Excel ...;o)
Tu actives la référence "Microsoft Outlook xx.xx Object Library" pour piloter Outlook depuis Excel.
Dans l'éditeur de macros
Menu Outils
Références
Coche la ligne "Microsoft Outlook xx.xx Object Library"
(xx.x dépend de ta version d'Office)
Clique sur le bouton OK pour valider.

Je voudrais pas recuperer mes 15000 fichiers de ma boite email! LOL

Je ne t'ai proposé qu'un exemple général car tu ne donnais aucune indication dans ton premier message.
Ensuite tu peux restreindre la procédure si tu le souhaites.

L'idéal serait de rechercher dans un seul dossier, à condition que les messages soient stockés au même endroit.
Tu peux paramétrer des règles pour gérer la réception de tes messages (transfert dans un dossier particulier) et ensuite faire l'extraction uniquement sur ce dossier. ça évitera de perdre du temps car la macro peut être longue.




Sinon, tu peux aussi utiliser une macro directement dans Outlook:
A placer dans le module objet ThisOutlookSession
cela va permettre le lancement automatique de la procédure, dès la reception d'un nouveau message.

la macro vérifie si le sujet du message commence par "RC - Rapport Client", puis enregistre sur le PC les pièces jointes contenues dans le mail.

Private Sub Application_NewMail()
    Dim olSpace As NameSpace
    Dim olFolder As MAPIFolder, olInbox As MAPIFolder
    Dim olMsg As MailItem
    Dim pceJointe As Attachment
    Dim y As Integer, x As Integer
    
    Set olSpace = Application.GetNamespace("MAPI")
    Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
    
    'boucle sur tous les messages de la boîte de réception
    For Each olMsg In olInbox.Items
       'Vérifie le début du titre du message
       If Left(olMsg.Subject, 19) = "RC - Rapport Client" Then
            'Vérifie s'il y a des pièces jointes
            If Not olMsg.Attachments.Count = 0 Then
                'boucle sur les pièces jointes
                For y = 1 To olMsg.Attachments.Count
                     Set pceJointe = olMsg.Attachments(y)
                     x = x + 1
                     'Enregistre la pièce jointe sur le disque.
                     pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                    Set pceJointe = Nothing
                Next y
            End If
            
       End If
End Sub

Bonne journée
MichelXld

 

[VBA_DEAD]

Re : Extraire files d`emails regroupes ds dossier

Bonjour Michel XLD, le forum

Ben merci. J`ai de quoi faire.

A ce stade j`ai colle tous mes emails ds ma boite outlook ds un fichier "Rapports".

Alors je veux faire ce que tu dis, c`est a dire chercher que sur ce dossier pour pas recuperer toutes mes pieces jointes.

je veux pas me planter si la macro est longue mais c`est a ce niveau que j`indique ds quel dossier de ma boite outlook aller chercher?

Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)

Moisd c`est "Rapports" mon fichier
Merci beaucoup car ca va me sauver la vie

VBA_DEAD

 

[elokapo]

Re : Extraire files d`emails regroupes ds dossier

Bonjour,

Comment lui dire de rechercher uniquement dans un dossier spécifique ? Ex le dossier "Indices" ?

2eme cas : si le dossier se trouve dans une mailbox commune... est-ce toujours possible ?

merci beaucoup par avance,
Elokapo

 

[MichelXld]

Re : Extraire files d`emails regroupes ds dossier

Bonsoir,

Comment lui dire de rechercher uniquement dans un dossier spécifique ? Ex le dossier "Indices" ?

Tu peux utiliser :

Set olInbox = olSpace.GetDefaultFolder(olFolderInbox).Folders("Indices")

bonne soirée
michel

 

[EXCELERATOR]

Re : Extraire files d`emails regroupes ds dossier

Michel XLD
ta macro sous outlook va mettre très utile:
Malheureusement il manque un next ??
Que faut-il que je mettes SVP ?

merci

 

[EXCELERATOR]

Re : Extraire files d`emails regroupes ds dossier

J'ai ajouté un next...

Maintenant j'ai une erreur du type : erreur d'execution 13, incompatibilité de type

Est-il possible de contourner ce problème?

merci à tous

 

[ChTi160]

Re : Extraire files d`emails regroupes ds dossier


Salut EXCELERATOR
Bonjour le Fil (un bonjour particulier , à notre mine d'or , qu'est Michel Lol)
Bonjour le Forum

je ne sais pas si tu as résolu ton problème , mais ci dessous l'emplacement ou le Next fait défaut

[COLOR=red]For[/COLOR] Each olMsg In olInbox.Items
       'Vérifie le début du titre du message
       If Left(olMsg.Subject, 19) = "RC - Rapport Client" Then
            'Vérifie s'il y a des pièces jointes
            If Not olMsg.Attachments.Count = 0 Then
                'boucle sur les pièces jointes
                [COLOR=blue]For[/COLOR] y = 1 To olMsg.Attachments.Count
                     Set pceJointe = olMsg.Attachments(y)
                     x = x + 1
                     'Enregistre la pièce jointe sur le disque.
                     pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                    Set pceJointe = Nothing
                [COLOR=blue]Next[/COLOR] y
            End If
            
       End If
 [COLOR=red]Next[/COLOR] '<---------- [COLOR=green]Ici celui qui te manque[/COLOR]

Bonne journée

 

[EXCELERATOR]

Re : Extraire files d`emails regroupes ds dossier

Salut ChTi160
Merci de t'intéresser à mon problème. Effectivement j'ai trouvé la solution en ajoutant exit for puis next.

Merci à toi et à plus


Private Sub Application_NewMail()
Dim olSpace As NameSpace
Dim olFolder As MAPIFolder, olInbox As MAPIFolder
Dim olMsg As MailItem
Dim pceJointe As Attachment
Dim y As Integer, x As Integer

Set olSpace = Application.GetNamespace("MAPI")
Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)

'boucle sur tous les messages de la boîte de réception
For Each olMsg In olInbox.Items
'Vérifie le début du titre du message
If Left(olMsg.Subject, 40) = "Rapport journalier de fabrication - LCB" Then
'Vérifie s'il y a des pièces jointes
If Not olMsg.Attachments.Count = 0 Then
'boucle sur les pièces jointes
For y = 1 To olMsg.Attachments.Count
Set pceJointe = olMsg.Attachments(y)
x = x + 1
'Enregistre la pièce jointe sur le disque.
pceJointe.SaveAsFile "D:\Documents and Settings\Bureau\Rapports journaliers\" & x & "_" & pceJointe
Set pceJointe = Nothing
Next y
End If

End If
Exit For
Next
End Sub