Jeudi 21 Juin 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

 beaulieu 10 semaines
 callaghi 14 semaines
 EMERGENCY 18 semaines
 Charlie76 19 semaines
 joscopp 30 semaines
 JièL 30 semaines
 julbast 31 semaines
 pirobert 31 semaines
 zorro71 55 semaines
 Alphator 73 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:1 977
En ligne :2
Max. en ligne:312
Max. / jour:66 529
Total hier:5 107
Total ce mois:83 382
Total visites:19 977 379
Moyenne/jour:5 696

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 10470 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
R18020 Dépasser la limites de 32Ko des règles avec un serveur Exchange, R07120 Interdire l'accès au paramétrage des comptes de messagerie et de carnet d'adresses, R15300 [VBA] Enregistrer dans un dossier après envoi, R99130 Un tapis de souris..., R01190 Personnaliser la page d’accueil « Outlook Aujourd’hui », R12055 Planifier une réunion, R08041 Outlook 2002 (2000 ?) ne mémorise pas le mot de passe des comptes sous Vista, R08160 L'entête du mail ne s'imprime pas (XP SP2 et IE7), R13020 Créer une tâche rapidement, R13060 Répondre à une demande de tâche, R99240 Quomen pozé une kestion, R15300 [VBA] Enregistrer dans un dossier après envoi, R16020 Importer des contacts d'un fichier Excel, R10095 Utiliser PFBACKUP avec Outlook 2010, R99010 Marche je te dis, marche...

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