Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

RÉCUPÉRÉ AUTOMITIQUEMENT UNE PIÈCE JOINTE D'UN E-MAIL SOUS OUTLOOK


Information sur la source

Catégorie :VBA Niveau : Initié Date de création : 21/03/2002 Date de mise à jour : 12/04/2002 11:35:48 Vu / téléchargé: 5 887 / 494

Note :
Aucune note

Commentaire sur cette source (7)
Ajouter un commentaire et/ou une note

Description

Ce code permet de récupérer les fichiers attachés dans de nouveaux mails.
Ici on récupère les pièces jointes des message dont l'objet est "Les fichiers zip" et on les sauvegarde dans un répertoire.  
 

Source

  • Private Sub Application_NewMail()
  • 'Set myOlApp = CreateObject("Outlook.Application") ' mettez cela si vous l'utiliser directement sur VB
  • Set myOlApp = CetteSessionOutlook ' mettez cela si vous l'utiliser directement sur Outlook
  • Set myNamespace = myOlApp.GetNamespace("MAPI")
  • Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
  • nb_messages = myFolder.Items.Count
  • For i_mess = 1 To nb_messages
  • estLu = myFolder.Items(i_mess).UnRead
  • If estLu = True Then
  • Set myItem = myFolder.Items(i_mess)
  • myItem.Display
  • Set myItem2 = Application.ActiveInspector.CurrentItem
  • If Left(myItem2, 16) = "Les fichiers zip" Then
  • Set myAttachments = myItem2.Attachments
  • nb_fic = myAttachments.Count
  • If nb_fic <> 0 Then
  • For i = 1 To nb_fic
  • mois = Int(Right(Left(myAttachments.Item(i).DisplayName, 6), 2))
  • myAttachments.Item(i).SaveAsFile "c:\sauv_mail" & _
  • myAttachments.Item(i).DisplayName
  • Next i
  • End If
  • End If
  • End If
  • Next i_mess
  • End Sub
Private Sub Application_NewMail()


'Set myOlApp = CreateObject("Outlook.Application") ' mettez cela si vous l'utiliser directement sur VB
Set myOlApp = CetteSessionOutlook ' mettez cela si vous l'utiliser directement sur Outlook
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)

nb_messages = myFolder.Items.Count
For i_mess = 1 To nb_messages
    estLu = myFolder.Items(i_mess).UnRead

    If estLu = True Then
        Set myItem = myFolder.Items(i_mess)
        myItem.Display

        Set myItem2 = Application.ActiveInspector.CurrentItem

        If Left(myItem2, 16) = "Les fichiers zip" Then
            Set myAttachments = myItem2.Attachments
            nb_fic = myAttachments.Count
            If nb_fic <> 0 Then
                For i = 1 To nb_fic
                mois = Int(Right(Left(myAttachments.Item(i).DisplayName, 6), 2))
                    myAttachments.Item(i).SaveAsFile "c:\sauv_mail" & _
                    myAttachments.Item(i).DisplayName
                Next i
            End If
        End If
    End If
Next i_mess
End Sub   

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

Commentaires et avis

signaler à un administrateur
Commentaire de Billou le 23/03/2002 13:13:11

tu peux mettre un zip ca serait + clair merci
a+

signaler à un administrateur
Commentaire de MSteve52 le 05/07/2002 20:50:12

pourquoimyAttachments.Item(i).SaveAsFile ...
déclenche-t-il l'appartion d'une boîte de dialogue m'indiquant que je n'ia pas les droits pour faire cela.
Merci

signaler à un administrateur
Commentaire de Como le 19/02/2003 16:37:51

Pourrais-tu commenter ton code s'il te plait ?

signaler à un administrateur
Commentaire de OLLIVIER le 30/06/2003 11:46:01

(olFolderInbox) represente quel folder.

le but de ton  code m'interresse mais cela ne fonctionne pas chez moi


as tu un exemple complet


merci d'avance

signaler à un administrateur
Commentaire de XLMbinny le 22/06/2004 08:54:50

C idem chez moi. Ce code me serait vraiement utile, d'ailleurs c'est en je cherchant cette action que j'ai découvert ce site. Mais ca ne fonctionne pas non plus ici.

Si certain ont des infos sur ce code,

Merci à vous !!

signaler à un administrateur
Commentaire de jenial le 26/09/2004 18:30:55

trop bon...

signaler à un administrateur
Commentaire de kopeltar le 24/12/2004 15:39:52

Bonjour,
  J'ai vu que tu as posté des messages à propos de outlook, donc j'ai pensé que tu pourrais m'aider,
   Je t'expose mon pb, je veux stocker les pièces jointes des nouveaux mails ds un répertoire sur mon disque, et pour cela j'utilise au début le code ci-dessous, mais le pb c que myFolder.Items.Count crenvoie toujours 0 même si je reçois de nouveaux messages . D'avance merci pour ton aide,
Set myOlApp = New Outlook.Application
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)

nb_messages = myFolder.Items.Count
For i_mess = 1 To nb_messages
.......

Ajouter un commentaire



Nos sponsors

Sondage...

CalendriCode

Janvier 2009
LMMJVSD
   1234
567891011
12131415161718
19202122232425
262728293031 

Consulter la suite du CalendriCode



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel BAÏSE, Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,234 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.