Mardi 30 Mai 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

 zorro71 1 jour
 callaghi 9 semaines
 Alphator 18 semaines
 ande 24 semaines
 Oliv 26 semaines
 cubitus 29 semaines
 JièL 34 semaines
 angel 39 semaines
 Quartzkyte 48 semaines
 grouilau 48 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:2 295
En ligne :4
Max. en ligne:312
Max. / jour:66 529
Total hier:4 178
Total ce mois:112 864
Total visites:17 551 461
Moyenne/jour:5 625

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 »  [>>]
R15200 [VBA] Enregistrer en .msg
Enregistre  le mail, le contact, la tâche ou le rdv en cours en fichier .msg dans un dossier de l'explorateur.

Sub sav_mail_as_msg(Optional objCurrentMessage As Object)
'By Oliv' juillet 2007 pour OUTLOOK 2003
 
If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
'Ici on construit le nom du fichier qui sera créé
NomExport = objCurrentMessage.Subject & objCurrentMessage.CreationTime
 
'Ici on définit le répertoire où l'enregistrer
repertoire = "c:\temp\"
'repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"
 
'Ici on supprime les caractères non autorisés dans les noms de fichiers
PathNomExport = repertoire & "Email " & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
NomExport,
"\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
 
'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
n = 1
MemPath = PathNomExport
While Dir(PathNomExport) <> ""
MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
PathNomExport = Left(MemPath, Len(MemPath) -
4) & "(" & n & ")" & ".msg"
n = n + 1
   
Wend
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
 
End Sub
 
Sub LanceSurOuvert()
sav_mail_as_msg
End Sub
 
 
Sub LanceSurSelection()
Dim MonOutlook As Outlook.Application
Dim LeMail As Object
Dim LesMails As Outlook.Selection
Set MonOutlook = Outlook.Application
 
Set LesMails = MonOutlook.ActiveExplorer.Selection
 
   
For Each LeMail In LesMails
    sav_mail_as_msg LeMail
   
Next LeMail
 
Set LesMails = Nothing
MsgBox "Fin de traitement"
End Sub


Il faut exécuter LanceSurOuvert à partir de l'élément ouvert ou LanceSurSelection à partir d'une sélection d'éléments.

Pour choisir directement le dossier où enregistrer le fichier copié
dans un autre module ou avant la macro ci-dessus la fonction BrowseForFolder se trouvant là :


http://www.c2i.fr/code.asp?IDCode=1083

Publié par Oliv le jeudi 15 février 2007 18:21 3 Commentaires 25611 Lecture(s) Imprimer
Commentaires
#1 | Snejena le jeudi 19 février 2009 16:56
Oliv, merci pour ce code mais je n'arrive pas à accèder à celui sur http://www.c2i.fr/code.asp?IDCode=1083

Merci
#2 | JièL le jeudi 19 février 2009 19:31
C'est le souci avec les liens externes, les sites changent et nous on ne suit pas
#3 | Paul73 le lundi 14 février 2011 11:58
Merci beaucoup pour ce bout de script, il a marché au premier coup, et il va me rendre de grand service.

Pour mettre la bon format de date, je remplace "objCurrentMessage.CreationTime" par "Format(objCurrentMessage.CreationTime, "yyyy-mm-dd" )"
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
R99060 Solution RA-DI-CA-LE !, R11020 Restaurer les paramètres et fichiers .pst d'Outlook 2002 (Windows XP seulement), R01170 Remplacer la page d’accueil de « Outlook Aujourd’hui » (version 2002/2003), R03110 Déplacer les messages lors de l'envoi, R01060 Définir une adresse de retour différente, temporairement, R20110 Configurer un compte POP pour Outlook 2007, R03040 Choisir un papier à lettres pour un message, R08190 Outlook se bloque au démarrage, R14020 Recherche avancée, R12090 Ajouter les jours fériés Français jusqu'en 2012 pour Outlook 2002/2003, R12050 Définir un rendez-vous répétitif, R14020 Recherche avancée, R15310 [VBA] Limiter l'envoi selon la taille, R14050 Créer des raccourcis vers des dossiers , R15600 [VBA] ajouter un dossier contact et le définir en tant que carnet d'adresses

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