Lundi 20 Février 2017  
Navigation
FAQ Outlook
» Foire Aux Questions «
Recherche
Téléchargements
Forums Outlook
Plan du site
Liens
Login

Les inscriptions sont fermées

Pseudo

Mot de passe

Se souvenir de moi



Mot de passe oublié ? Mot de passe oublié ?
Connexions
Bienvenue à [FAMACLUB]
le 1,414ème membre
Visiteurs en ligne : 1
Membres en ligne : 0

 Alphator 4 semaines
 ande 10 semaines
 Oliv 12 semaines
 cubitus 15 semaines
 callaghi 19 semaines
 JièL 20 semaines
 angel 25 semaines
 Quartzkyte 34 semaines
 grouilau 34 semaines
 miguy973 43 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:4 959
En ligne :1
Max. en ligne:312
Max. / jour:66 529
Total hier:5 544
Total ce mois:84 106
Total visites:16 981 723
Moyenne/jour:5 619

Dernières 24h

























Publicité ; elle permet de financer le site
Navigation parmi les catégories/articles
« Catégorie     Q15000 Macros - VBA (41)  Catégorie »
[<<]  « Article  Article »  [>>]
R15250 [VBA] ImagesDansMessage
Voici un code produit par Isabelle Prawitz qui déplace les images en pièces jointes d'un mail HTML dans un dossier Windows et ajoute un lien dans le corps afin de les visualiser directement, un peu comme Outlook Express.
Vous devez créer un dossier sur votre disque dur ici :
c:\Pieces jointes\

Vous pouvez appeler cette Macro dans l'événement Application_NewMail pour que ce soit appliqué à l'arrivée d'un nouveau mail.


Attention cela agit sur tous les mails HTML de la boîte de réception !!!! et supprime la pj.

Cela ne gère pas non plus les doublons de nom dans le répertoire des PJ !!

Pour éviter les erreurs j'ai commenté la ligne Delete et ajouté un message de confirmation.

Sub ImagesDansMessage() Dim leMess As MailItem

Dim LItem As Object

Dim LeDoss As MAPIFolder

Dim lesItems As Items

Dim laPJ As Attachment

Dim nbAtt As Integer

Dim i As Integer

Dim NS As NameSpace

Set LeDoss = Session.GetDefaultFolder(olFolderInbox)

Set lesItems = LeDoss.Items For Each LItem In lesItems

If TypeName(LItem) = "MailItem" Then

Set leMess = LItem

nbAtt = leMess.Attachments.Count

If leMess.BodyFormat = olFormatHTML And nbAtt > 0 Then

'à commenter si vous ne voulez pas de message

Traiter = MsgBox(leMess.Subject, vbYesNoCancel, "Voulez vous traiter ce mail ?")

If Traiter = vbCancel Then Exit Sub

If Traiter <> vbNo Then


For Each laPJ In leMess.Attachments If Right(LCase(laPJ.FileName), 4) = ".jpg" Or _
Right(LCase(laPJ.FileName), 4) = "jpeg"
Or _

Right(LCase(laPJ.FileName), 4) = ".gif" Then

' *** attention Dossier à paramétrer

laPJ.SaveAsFile "C:\TEMP\pj\" & laPJ.DisplayName

' *** attention Dossier à paramétrer

leMess.HTMLBody = "<IMG alt'' hspace0 src'" & _

"C:\TEMP\pj\" & laPJ.DisplayName & _

"' alignºseline border0><br>" & _

leMess.HTMLBody

End If

Next

For i = leMess.Attachments.Count To 1 Step -1

Set laPJ = leMess.Attachments.Item(i)

If Right(LCase(laPJ.DisplayName), 4) = ".jpg" Or _
Right(LCase(laPJ.DisplayName), 4) = "jpeg" Or _

Right(LCase(laPJ.DisplayName), 4) = ".gif" Then

'en décommentant le ligne ci-dessous vous surprimez la PJ du mail.

'laPJ.Delete

End If

Next

leMess.Save

End If

End If

End If

Next

End Sub

'Fin de macro








Publié par Oliv le mardi 24 avril 2007 15:13 0 Commentaires 9133 Lecture(s) Imprimer
Commentaires
les commentaires sont fermés.
Copyright et partage
Ce site est sous licence Creative Commons.
Vous pouvez utiliser toutes les informations présentent ici, mais il vous est interdit de les reproduire sans citer la source.

Creative Commons License
OUI au partage
NON au « copillage »

Ajouter aux favoris / partager : 
URL :
BBcode :
HTML :
Cliquez ci dessus sur le lien que vous voulez copier et [Ctrl] + [C] ou cliquez sur le bouton [ C ]
Articles similaires
Articles Catégories
R15045 [VBA] Ouvrir l'arborescence des pst contenant une boîte de réception Q15000 Macros - VBA
R15930 [VBA] Création de menu dans outlook Q15000 Macros - VBA
R15380 [VBA] Envoi via VBA : suppression de la confirmation d'envoi Q15000 Macros - VBA
R15280 [VBA] Exporter un mail et l'ouvrir dans IE avec ses images Q15000 Macros - VBA
R15930 [VBA] Eliminer les doublons Q15000 Macros - VBA
Nuage de tags
R04060 Supprimer les pièces jointes d'un message, R15310 [VBA] Limiter l'envoi selon la taille, R03070 Créer son papier à lettres personnel, R16010 Importer les messages d'Outlook Express, R15040 [VBA] Parcourir tous les dossiers et sous-dossiers., R11090 Récupérer des messages effacés, R05010 Ne pas imprimer la liste des (nombreux) destinataires d'un message, R15240 [VBA] Viewer de pièces jointes., R21010 Ajouter une signature automatique aux messages (Outlook 2007), R17010 Impossible d'exporter les données de champs personnalisés, R20030 Configurer un compte Hotmail (Windows Live Hotmail) pour Outlook 2002/2003, R99200 Pourquoi la copie est merdique ?, R05030 Modifier la police et la taille des caractères du corps du message, R15050 [VBA] Modifier l'affichage sur tous les dossiers et sous-dossiers, R09010 Compléter la saisie d’un destinataire (saisie auto ou saisie semi auto)

aucun Crack, CrackZ, no-CD, DownloadZ, TelechargementZ, Serial, Numéro de série, N0 de série, Serialz ni Keygen pour Outlook sur ce site.

Blague aléatoire
Publicité
Météo Marseille
[/\] Copyright JièL / Jean-Louis Goubert © 2003-2009 [/\]