 | Navigation |  |
 | Login |  |
 | Connexions |  |
 | Bienvenue à [FAMACLUB] le 1,414ème membre Visiteurs en ligne : 4 Membres en ligne : 0
Non activés :0
Nombre de visiteurs depuis le : 12/11/2008
Aujourd'hui: | 485 | En ligne : | 4 | Max. en ligne: | 312 | Max. / jour: | 66 529 | Total hier: | 4 083 | Total ce mois: | 105 565 | Total visites: | 21 198 743 | Moyenne/jour: | 5 651 |
Dernières 24h
|  |  |  |  |
|
 | Publicité ; elle permet de financer le site |  |
 | Navigation parmi les catégories/articles |  |
 | 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
|  |  |  |  |
 | Commentaires |  |
 |
#1 |
le jeudi 19 février 2009 16:56
|
#2 |
le jeudi 19 février 2009 19:31
|
#3 |
le lundi 14 février 2011 11:58
|
|  |  |  |  |
 | Copyright et partage |  |
 | Articles similaires |  |
 | Nuage de tags |  |
 | R01010 Définir Outlook comme messagerie par défaut, R18030 Les noms des dossiers s'affichent en Anglais, R12040 Créer un rendez-vous, R06070 Classer automatiquement les messages reçus ou envoyés, R08060 Recréer un profil, R12110 Un éphéméride dans Outlook, R11040 Restaurer ses règles de gestion des messages, R99220 Des fois on se dit qu'il mérite..., R12080 Publier son planning sur Internet / Intranet ou un réseau personnel, R16040 Importer le carnet d'adresses d'Outlook Express dans Outlook, R03050 Définir le papier à lettres par défaut, R00100 Afficher les GIFs animés avec Outlook 2007, R15930 [VBA] Eliminer les doublons, R99110 Ebook pas cher, R08070 Réparer / remettre en état Outlook ou le PST (6 solutions à appliquer dans l'ordre) |  |  |  |  |
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 |  |
|
Merci