Jeudi 27 Juillet 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 : 4
Membres en ligne : 0

 EMERGENCY 1 jour
 callaghi 1 semaine
 JièL 4 semaines
 zorro71 8 semaines
 Alphator 26 semaines
 ande 32 semaines
 Oliv 34 semaines
 cubitus 37 semaines
 angel 48 semaines
 Quartzkyte 56 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:731
En ligne :3
Max. en ligne:312
Max. / jour:66 529
Total hier:5 137
Total ce mois:144 188
Total visites:17 966 881
Moyenne/jour:5 654

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 9383 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
R10095 Utiliser PFBACKUP avec Outlook 2010, R12080 Publier son planning sur Internet / Intranet ou un réseau personnel, R14060 Gérer vos Notes, R14040 Personnaliser la barre d'outils d'Outlook, R07070 Activer / Paramétrer le filtre anti spam d'Outlook 2003/2007, R15050 [VBA] Modifier l'affichage sur tous les dossiers et sous-dossiers, R11030 Importer tout ou partie d'un fichier .PST, R08200 Cette opération a été annulée à cause de restrictions en vigueur sur cet ordinateur. Contactez votre administrateur système., R09190 Trier les destinataires dans le carnet d'adresses (version 2002/2003), R17005 Création d'éléments basique, R04030 Enregistrer rapidement les pièces jointes, R08080 Message d'erreur lors de l'utilisation du carnet d'adresses, R17004 Etapes permettant l'utilisation d'un formulaire, R15040 [VBA] Parcourir tous les dossiers et sous-dossiers., R15220 [VBA] Supprimer les Pièces jointes.

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 [/\]