Lundi 18 Novembre 2019  
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

 pirobert 26 semaines
 jcgdisle 51 semaines
 EMERGENCY 72 semaines
 beaulieu 84 semaines
 callaghi 87 semaines
 Charlie76 93 semaines
 joscopp 104 semaines
 JièL 104 semaines
 julbast 105 semaines
 zorro71 129 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:2 646
En ligne :4
Max. en ligne:312
Max. / jour:66 529
Total hier:2 974
Total ce mois:63 604
Total visites:22 948 144
Moyenne/jour:5 706

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 17057 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
R01080 Différer l'envoi d'un message, R13050 Affecter une tâche à quelqu'un, R14010 Recherche rapide , R12080 Publier son planning sur Internet / Intranet ou un réseau personnel, R15500 [VBA] Envoyer un fichier OFFICE par mail, R15370 [VBA] Envoyer ou renvoyer un ou plusieurs mails, R08130 Les messages d'un compte POP sont téléchargés N fois, R08070 Réparer / remettre en état Outlook ou le PST (6 solutions à appliquer dans l'ordre), R99190 Vieille souris, R99460 Vous hésitez encore ?, R09125 Exporter les contacts d'Outlook vers Outlook Express, R15305 [VBA] Enregistrer après envoi sur le disque, R00110 Vérifier une adresse mail avant d'envoyer un message, R11020 Restaurer les paramètres et fichiers .pst d'Outlook 2002 (Windows XP seulement), R21010 Ajouter une signature automatique aux messages (Outlook 2007)

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