Samedi 22 Juillet 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 : 4
Membres en ligne : 0

 callaghi 1 semaine
 EMERGENCY 2 semaines
 JièL 3 semaines
 zorro71 7 semaines
 Alphator 26 semaines
 ande 31 semaines
 Oliv 33 semaines
 cubitus 37 semaines
 angel 47 semaines
 Quartzkyte 56 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:3 348
En ligne :4
Max. en ligne:312
Max. / jour:66 529
Total hier:4 761
Total ce mois:122 457
Total visites:17 941 097
Moyenne/jour:5 654

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 »  [>>]
R15050 [VBA] Modifier l'affichage sur tous les dossiers et sous-dossiers
Voici qui permet donc de remplacer l'affichage des dossiers et sous dossiers par un nouvel affichage préalablement créé.
 Sub Change_affichage_Dossiers()
'by OLIV' 31/10/2007 pour outlook 2003
    Dim objNS As Outlook.NameSpace
    Dim objFolder As MAPIFolder
    Set objNS = Application.GetNamespace("MAPI")
'on choisi le dossier
    Set objFolder = objNS.PickFolder
 
    Dim objInsp
    Dim colCB
    Dim objCBB
    On Error Resume Next
    Set objInsp = ActiveExplorer
    Set colCB = objInsp.CommandBars
    Set objCBB = colCB.FindControl(, 30124)
    For i = 1 To objCBB.Controls.Count
    If Not objCBB.Controls(i).Caption Like "*&*" Then choix = choix & vbCr & i & "-" & objCBB.Controls(i).Caption
    Next i
    Ancien = InputBox(choix, "Choisissez l'ancien affichage")
    Nouveau = InputBox(choix, "Choisissez le nouvel affichage")
    If IsNumeric(Ancien) And IsNumeric(Nouveau) Then
    'Ici on exécute la macro en question
        ProcessFolderAffichage objFolder, objCBB.Controls(CInt(Ancien)).Caption, objCBB.Controls(CInt(Nouveau)).Caption
    End If
    MsgBox "Opération terminée"
End Sub
 
 
 
Private Sub ProcessFolderAffichage(StartFolder As Outlook.MAPIFolder, Ancien As String, Nouveau As String)
'by OLIV' 31/10/2007 pour outlook 2003
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem As Object
    On Error Resume Next
   
    Dim myolApp As Outlook.Application
    Set myolApp = Outlook.Application
    Dim Activexpl As Explorer
    Set Activexpl = myolApp.ActiveExplorer
 
   ' Ici on fait quelque chose dans chaque dossier
   ' on écrit une ligne dans la fenêtre exécution
    Debug.Print StartFolder.FolderPath, StartFolder.Items.Count, StartFolder.CurrentView.Name, StartFolder.CurrentView.ViewType, StartFolder.DefaultItemType
    If StartFolder.DefaultItemType = olMailItem And StartFolder.CurrentView.Name = Ancien Then
        'ici on positionne l'explorer au  même endroit
        Set Activexpl.CurrentFolder = StartFolder
   
        DoEvents
        If Not StartFolder.Name Like "Boîte aux lettres*" Then Activexpl.CurrentView = Nouveau
    End If
       
    ' Parcourt tous les sous-dossiers de ce dossier
    For Each objFolder In StartFolder.Folders
        Call ProcessFolderAffichage(objFolder, Ancien, Nouveau)
    Next
   
    ' Parcourt tous les éléments de ce dossier.
'    For Each objItem In StartFolder.Items
'        Call ProcessItem(objItem)
'    Next
   
    Set objFolder = Nothing
End Sub


Publié par Oliv le mercredi 31 octobre 2007 15:07 1 Commentaire 9856 Lecture(s) Imprimer
Commentaires
#1 | 7 le mercredi 19 décembre 2007 14:37
Bonjour,

Super boulot, bravo à l'auteur !

Trois petites choses pour parfaire le truc :
- il manque un espace sur la première ligne entre Sub et Change
- amha, il faudra changer le titre des messages box "Ancien" et "Nouveau" par un truc qui suggèrerait de donner le numéro de la règle et pas le nom
- peut être un petit topo sur "ou mettre le truc", "comment faire pour l'utiliser", ...

Merci Oliv'

@+lolo
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
R15045 [VBA] Ouvrir l'arborescence des pst contenant une boîte de réception Q15000 Macros - VBA
R15930 [VBA] Création de menu dans outlook Q15000 Macros - VBA
R17070 VSTO et les formulaires d'Outlook 2007 Q17000 Formulaires
R18040 VBScript: Créer une signature personnalisée par utilisateur sous Outlook 2003/2007 Q18000 Outlook et Exchange
Nuage de tags
R09125 Exporter les contacts d'Outlook vers Outlook Express, R00020 Mettre Outlook 2002 (et autres) dans le systray, R99210 Y'a pas que les ordis qui rament, R10060 Sauvegarder le carnet d'adresses personnel (.PAB), R01060 Définir une adresse de retour différente, temporairement, R10020 Sauvegarder les paramètres et fichiers .PST d'Outlook 2002 (Windows XP seulement), R15910 [VBA] Executer une macro à heure FIXE ou selon une période., R05070 Imprimer les noms des pièces jointes aux messages en HTML, R15040 [VBA] Parcourir tous les dossiers et sous-dossiers., R02010 Connexion / Déconnexion automatique à Internet, R07080 Ajouter un expéditeur indésirable, R15430 [VBA] Cocher plusieurs calendriers à l'ouverture, R15400 [VBA] Changer les parametres POP des COMPTES, R03090 Rechercher les messages d'un même auteur, R01010 Définir Outlook comme messagerie par défaut

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