Lundi 01 Juin 2020  
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 : 2
Membres en ligne : 0

 JièL 5 semaines
 manucau 7 semaines
 Manu-pb 8 semaines
 Oliv 13 semaines
 pirobert 54 semaines
 jcgdisle 79 semaines
 EMERGENCY 100 semaines
 beaulieu 112 semaines
 callaghi 115 semaines
 Charlie76 121 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:650
En ligne :2
Max. en ligne:312
Max. / jour:66 529
Total hier:0
Total ce mois:650
Total visites:23 646 576
Moyenne/jour:5 606

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 10857 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
R20190 Configurer un serveur SMTP sécurisé pour Outlook 2007, R15410 [VBA] Remplacer dans les Contacts l'envoi au format RTF, R12060 Répondre à une invitation, R16050 Importer d'un autre PC les courriels d'Outlook Express vers Outlook sous Vista, R03130 Voir la source du message dans l'entête, R15350 [VBA] Choix du compte selon les destinataires, R99100 BSOD, R01040 Laisser une copie de message sur le serveur, R16010 Importer les messages d'Outlook Express, R05040 Imprimer la partie utile d'un message, R16060 Importer les contacts de Windows Live Mail dans Outlook, R15260 [VBA] Copier le corps et les en-têtes vers le presse-papier, R10040 Sauvegardez ses règles de gestion des messages, R05060 Créer un « style » d'impression, R05050 Imprimer des « Contacts »

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é
[/\] Copyright JièL / Jean-Louis Goubert © 2003-2009 [/\]