Extraire pièce jointe outlook

[Anto35200]

Bonjour au forum,


Grand débutant en VBA, je cherche une macro qui puisse s'exécuter depuis Excel (si possible).

La macro devrait:


1-Aller chercher des fichiers Excel dans un dossier de ma Boite de réception intitulé "PAYS"

2-Récupérer tous les mails de ce dossier PAYS de la manière suivante :

a)Copier les pièces jointes de chaque expéditeur vers un chemin spécifique nommé C:\PRODUITS\... : par exemple
Si adresse mail expéditeur ...@congo.com avec pièce jointe produitA.xls, renommer ce fichier en banane.xls
Si adresse mail expéditeur ...@bresil.com avec pièce jointe produitB.xls, renommer ce fichier en sucre.xls

b) Archiver ensuite ces mails dans un dossier de la boîte de réception ARCHIVES

J'espère avoir été clair dans mes explications.



Merci d'avance.

 

[Anto35200]

Re : Extraire pièce jointe outlook

Lorsque j'ai le message d'erreur en post #14, c'est à cette ligne de code de la macro :

For Each SousDossier In Fld.Folders

 

[Yaloo]

Re : Extraire pièce jointe outlook

Re,

Lorsque tu fais du pas à pas avec F8 (dans la macro ExportePiecesJointes), qu'as-tu au niveau de Dossier ?

 

[Anto35200]

Re : Extraire pièce jointe outlook

Bonjour Yaloo,

Lorsque je fais pas à pas,

j'ai "Dossier = Nothing" au

Set Dossier = Ns.Folders(1)

j'ai "Fichier de données Outlook" au

SearchFolders Dossier

 

[Yaloo]

Re : Extraire pièce jointe outlook

Bonjour plimosin, le forum,

C'est difficile pour moi de comprendre ce qui se passe chez toi, puisque chez moi tout fonctionne bien.
Voici ce que j'ai à la maison :

Avec la macro modifiée comme suit :

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)
  MsgBox Dossier
  SearchFolders Dossier
  x = 0
End Sub

le message me donne bien ma première adresse mail

si je mets

Set Dossier = Ns.Folders(2)

j'ai ma seconde adresse mail.

Peux-tu faire les mêmes manipulations, pour voir ce que tu as chez toi ?

A+

Martial

 

[Anto35200]

Re : Extraire pièce jointe outlook

Re,

aurais-tu la gentillesse de m'expliquer en détail ligne à ligne ton code en post #2

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, nom$, Email$
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 And SousDossier = "PAYS" Then
         For Each OLmail In SousDossier.Items
             If Not OLmail.Attachments.Count = 0 Then
                 For y = 1 To OLmail.Attachments.Count
                 Email = OLmail.SentOnBehalfOfName
                   Select Case Split(OLmail.SentOnBehalfOfName, "@")(1)
                     Case "congo.com": nom = "\banane.xls"
                     Case "bresil.com": nom = "\sucre.xls"
                   End Select
                      Set pceJointe = OLmail.Attachments(y)
                      x = x + 1
                      pceJointe.SaveAsFile "C:\PRODUITS" & nom
                     Set pceJointe = Nothing
                 Next y
             End If
         Next OLmail
     End If
     SearchFolders SousDossier
Next SousDossier
End Sub

Lorsque je mets ce code :

Set Dossier = Ns.Folders(2)

j'ai le message d'erreur : "Erreur d'exécution 287 : Erreur définie par l'application ou par l'objet" à cette ligne :

Email = OLmail.SentOnBehalfOfName

 

[Yaloo]

Re : Extraire pièce jointe outlook

Re,

Si tu passes à la ligne suivante, c'est bien, on avance .
Si tu mets, c'est que tu as au moins 2 adresses mail.

Set Dossier = Ns.Folders(2)

Pourtant tu m'as dit n'avoir qu'une seule adresse mail (c'est bizarre )

J'ai modifié un peu la macro et t'ai mis quelques explications.

A+

Martial

 

[Anto35200]

Re : Extraire pièce jointe outlook

Bonjour Yaloo


Bon, voilà, enfin çà marche !


Il manquait une barre oblique à la fin de ce code :

pceJointe.SaveAsFile "C:\PRODUITS\"

Néanmoins, j'ai d'autres requêtes à te demander :

1 - Est-il possible, que lorsque tous les mails qui sont dans PAYS soient classées ou transférés dans un autre dossier appelé ARCHIVES de la Boîte de réception une fois que la macro soit traitée ?

2 - Est-il possible de définir que si dans le dossier PAYS de la Boîte de réception,
si l'expéditeur jean.dupont@compagnie.com avec une pièce jointe ProduitC.xls, renommer ce fichier en cacao.xls dans le dossier C:\PRODUITS et évidemment transféré ce mail dans ARCHIVE une fois que la macro soit traitée.


En te remerciant par avance.

 

[Yaloo]

Re : Extraire pièce jointe outlook

Bonjour plimosin,

Vois avec le fichier ci-joint, le mail est déplacé dans le dossier Archives, uniquement s'il a des pièces jointes. S'il faut déplacer tous les mails, dis-le moi.

A+

Martial

 

[Yaloo]

Re : Extraire pièce jointe outlook

Oups, j'en ai oublié le point N° 2

Il suffit de rajouter dans Select Case ..... avant le Case Else

Case jean.dupont@compagnie.com : "\cacao.xls"

A+

 

[Anto35200]

Re : Extraire pièce jointe outlook

Bonjour Yaloo,

Je vais d’abord procéder par étape, en réponse à ton post #24, je ne vois pas trop ou faut-il mettre le mail en entier de l’expéditeur ? A quelle ligne ?

Merci de ton aide.

 

[Yaloo]

Re : Extraire pièce jointe outlook

Bonjour plimosin,

Il faut le mettre dans le Select Case, pour je te l'avais écrit vite faite, il manquait les guillemets et nom =
mais avec ce qui était déjà dans la macro tu aurais pu le voir par toi-même.

.....
        For y = 1 To OLmail.Attachments.Count
          'Selon le cas de l'adresse de l'envoyeur
          'Split permet de découper du texte, on lui demande la partie après le @
          Select Case Split(OLmail.SenderEmailAddress, "@")(1)
            'Si le domaine est congo.com, alors on donne la valeur \banane.xls à la variable nom
            Case "congo.com": nom = "\banane.xls"
            Case "bresil.com": nom = "\sucre.xls"
            Case "jean.dupont@compagnie.com": nom = "\cacao.xls"
            'Si le domaine n'est pas répertorié alors on passe à Suite
            Case Else: GoTo Suite
          End Select
          'On récupère la pièce jointe
....

A+

Martial

 

[Anto35200]

Re : Extraire pièce jointe outlook

Bonjour Yaloo,


J’ai beau mentionné le mail complet de l’expéditeur jean.dupont@compagnie.com comme indiqué, mais le code ne me copie en aucun le fichier...

  Case "congo.com": nom = "\banane.xls"
             Case "bresil.com": nom = "\sucre.xls"
             Case "jean.dupont@compagnie.com": nom = "\cacao.xls"
             'Si le domaine n'est pas répertorié alors on passe à Suite
             Case Else: GoTo Suite
           End Select

 

[Yaloo]

Re : Extraire pièce jointe outlook

Bonjour plimosin,

En effet, ça ne peut pas fonctionner comme ça, je suis un flan , puisque dans le Select Case il n'est traité que les noms de domaine. Mais comme je ne peux pas testé ....
Il faut donc mettre, une condition différente si l'on cherche l'adresse complète.
Quelque chose du genre :

....
For y = 1 To OLmail.Attachments.Count
If Olmail.SenderEmailAddress = "jean.dupont@compagnie.com" Then nom = "\cacao.xls"
'Selon le cas de l'adresse de l'envoyeur
'Split permet de découper du texte, on lui demande la partie après le @
Select Case Split(OLmail.SenderEmailAddress, "@")(1)
'Si le domaine est congo.com, alors on donne la valeur \banane.xls à la variable nom
Case "congo.com": nom = "\banane.xls"
Case "bresil.com": nom = "\sucre.xls"
'Si le domaine n'est pas répertorié alors on passe à Suite
Case Else: GoTo Suite
End Select
'On récupère la pièce jointe
....

Toujours pas tester ....

A+

Martial

 

[Anto35200]

Re : Extraire pièce jointe outlook

Je teste ton nouveau code, j'ai ce message d'erreur:
"Erreur d'exécution '13' : Incompatibilité de type" à la ligne

Next OLmail

Suite:
        'On passe à la pièce jointe suivante
        Next y
      End If
    'On passe au mail suivant
    Next OLmail
  End If
  'On passe au sous-répertoire suivant
  SearchFolders SousDossier
Next SousDossier
End Sub

 

[Yaloo]

Re : Extraire pièce jointe outlook

Re,

D'après ce que j'ai pu tester chez moi, cette fois-ci ça devrait être fonctionnel.

A+