Mercredi 22 Mai 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 : 10
Membres en ligne : 0

 pirobert 1 semaine
 jcgdisle 26 semaines
 EMERGENCY 46 semaines
 beaulieu 58 semaines
 callaghi 62 semaines
 Charlie76 67 semaines
 joscopp 78 semaines
 JièL 78 semaines
 julbast 79 semaines
 zorro71 103 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:2 064
En ligne :10
Max. en ligne:312
Max. / jour:66 529
Total hier:7 205
Total ce mois:117 884
Total visites:21 784 802
Moyenne/jour:5 670

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 16417 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
R00110 Vérifier une adresse mail avant d'envoyer un message, R08160 L'entête du mail ne s'imprime pas (XP SP2 et IE7), R09030 Activer / Désactiver la suggestion des adresses de messagerie (saisie auto ou saisie semi auto), R00130 Fonctionnalités abandonnées et/ou modifiées dans Outlook 2007, R13030 Créer une tâche, R09200 Trier les destinataires dans le carnet d'adresses (version 2000), R11090 Récupérer des messages effacés, R08123 Impossible d'envoyer un message (mon FAI est Free), R07010 Créer plusieurs « profil » ou comment avoir plusieurs comptes séparés, R15930 [VBA] Création de menu dans outlook, R00110 Vérifier une adresse mail avant d'envoyer un message, R06050 Ouvrir un dossier d'archive (ou un autre .PST), R08250 Outlook ne trouve pas mes messages lors d'une recherche, R99070 Réglages masqués, R01200 Changer le son de réception d'un message

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