Mercredi 29 Mars 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 : 3
Membres en ligne : 0

 callaghi 1 jour
 Alphator 9 semaines
 ande 15 semaines
 Oliv 17 semaines
 cubitus 20 semaines
 JièL 25 semaines
 angel 31 semaines
 Quartzkyte 39 semaines
 grouilau 40 semaines
 miguy973 49 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:3 895
En ligne :3
Max. en ligne:312
Max. / jour:66 529
Total hier:6 355
Total ce mois:151 061
Total visites:17 271 557
Moyenne/jour:5 648

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 »  [>>]
R15045 [VBA] Ouvrir l'arborescence des pst contenant une boîte de réception

Lorsqu'on ouvre Outlook, toutes les arborescences des PST sont fermées, quoi qu'on ait fait en fermant.
Assez gênant quand on a des compte IMAP car il faut tous les réouvrir pour voir les boîtes de réception.
D'autre part, si il y a des raccourcis vers les boîtes de réception dans les dossiers favoris, on ne voit le nombre de messages non lus (en bleu) qu'après avoir ouvert l'arborescence du pst concerné.

Voici donc une macro permettant d'ouvrir au démarrage d'outlook l'arborescence de tous les pst contenant un dossier "Boîte de réception".


Il y a besoin de la fonction suivante :

Public Function RecupDossier(Chemin_Dossier As String) As MAPIFolder
' Permet d'initialiser un objet folder sur le dossier dont le chemin est passé en paramètre
' Le chemin du dossier doit être de cette forme
'   "Dossiers personnels\Dossier\Sous-dossier"
  
  Dim OL_App As Outlook.Application
  Dim OL_NS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim ListeDos() As String
  Dim i As Long
  On Error Resume Next

  ListeDos() = Split(Chemin_Dossier, "\")
  
  Set OL_App = CreateObject("Outlook.Application")
  Set OL_NS = OL_App.GetNamespace("MAPI")
  Set objFolder = OL_NS.Folders.Item(ListeDos(0))
  
  If Not objFolder Is Nothing Then
  
    For i = 1 To UBound(ListeDos)
    
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(ListeDos(i))
      If objFolder Is Nothing Then
        Exit For
      End If
      
    Next
    
  End If

  Set RecupDossier = objFolder
  Set colFolders = Nothing
  Set OL_NS = Nothing
  Set OL_App = Nothing
  
End Function

 

La macro à lancer pour effectuer le travail :

Sub ActiverComptes()
' Passer sur la boîte de réception de tous les pst
' Pour activer l'affichage des courriers non lus des dossiers IMAP
' sur les raccourcis des dossiers favoris

    Dim OL_App As Outlook.Application
    Dim OL_NS As Outlook.NameSpace
    Dim ListePst As Outlook.Folders
    Dim PST As Outlook.Folder
    Dim Dos_BteRecep As Outlook.Folder
    
    Set OL_App = CreateObject("Outlook.application")
    Set OL_NS = OL_App.GetNamespace("MAPI")
    Set ListePst = OL_App.Session.Folders
    
    For Each PST In ListePst
        Set Dos_BteRecep = RecupDossier(PST & "\Boîte de réception")
        If Not Dos_BteRecep Is Nothing Then Set OL_App.ActiveExplorer.CurrentFolder = Dos_BteRecep
        Set Dos_BteRecep = Nothing
    Next
    Set ListePst = Nothing
    Set PST = Nothing
    
    Set OL_App.ActiveExplorer.CurrentFolder = OL_NS.GetDefaultFolder(olFolderInbox)
    Set OL_App = Nothing
    Set OL_NS = Nothing

End Sub

 

Et pour que ce soit automatique au démarrage d'Outlook, dans ThisOutlookSession, vous devez avoir :

Private Sub Application_Startup()
    Call ActiverComptes
End Sub

 

La mise en forme du code VBA a été effectuée en partie grâce au travail de Michel Gaboly


Publié par Fabrice N le mercredi 26 janvier 2011 22:51 12152 Lecture(s) Imprimer
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
R06032 Utiliser l'archivage automatique avec les dates de réception Q06000 Les fichiers d'Outlook
R15930 [VBA] Création de menu dans outlook Q15000 Macros - VBA
R08250 Outlook ne trouve pas mes messages lors d'une recherche Q08000 Erreurs et problèmes
R18040 VBScript: Créer une signature personnalisée par utilisateur sous Outlook 2003/2007 Q18000 Outlook et Exchange
R21010 Ajouter une signature automatique aux messages (Outlook 2007) Q21000 Tutoriels VIDEOS (démo)
Nuage de tags
R14020 Recherche avancée, R15410 [VBA] Remplacer dans les Contacts l'envoi au format RTF, R16060 Importer les contacts de Windows Live Mail dans Outlook, R18020 Dépasser la limites de 32Ko des règles avec un serveur Exchange, R15050 [VBA] Modifier l'affichage sur tous les dossiers et sous-dossiers, R99460 Vous hésitez encore ?, R16030 Exporter les contacts, R09030 Activer / Désactiver la suggestion des adresses de messagerie (saisie auto ou saisie semi auto), R08210 Message d'erreur : Le client de courrier électronique par défaut n'est pas correctement installé, R07060 Afficher la source d'un message HTML, R17060 Remplacer les formulaires par défaut, R08240 Pourquoi la désinstallation/Réinstallation ne fait rien ?!, R14030 Ajouter / Supprimer un dossier au favoris, R09130 Rechercher dans le carnet d'adresses, R99470 Ca va mieux ?

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