Lundi 24 Septembre 2018  
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 : 2
Membres en ligne : 0

 EMERGENCY 12 semaines
 beaulieu 24 semaines
 callaghi 27 semaines
 Charlie76 33 semaines
 joscopp 44 semaines
 JièL 44 semaines
 julbast 45 semaines
 pirobert 45 semaines
 zorro71 69 semaines
 Alphator 87 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:1 990
En ligne :2
Max. en ligne:312
Max. / jour:66 529
Total hier:2 057
Total ce mois:75 197
Total visites:20 386 064
Moyenne/jour:5 660

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 15247 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
R03010 Créer un nouveau message à partir d'un autre, R17010 Impossible d'exporter les données de champs personnalisés, R20130 Configurer un compte Hotmail (Windows Live Hotmail) pour Outlook 2007, R01060 Définir une adresse de retour différente, temporairement, R08190 Outlook se bloque au démarrage, R01240 Modifier la durée d'affichage de « l'alerte » sur le bureau ou afficher une boîte de dialogue à valider., R06080 Créer rapidement une règle selon un message, R08090 Liste des codes d'erreurs et significations, R18020 Dépasser la limites de 32Ko des règles avec un serveur Exchange, R00030 Commutateurs de ligne de commande, R15440 [VBA] vider les courriers indésirables en quittant, R07110 Ajouter un expéditeur de confiance, R07110 Ajouter un expéditeur de confiance, R00010 Outlook ou Outlook Express ?, R06090 Appliquer une règle aux messages existants

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