Jeudi 16 Août 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 : 3
Membres en ligne : 0

 EMERGENCY 6 semaines
 beaulieu 18 semaines
 callaghi 22 semaines
 Charlie76 27 semaines
 joscopp 38 semaines
 JièL 38 semaines
 julbast 39 semaines
 pirobert 39 semaines
 zorro71 63 semaines
 Alphator 81 semaines

Non activés :0

Nombre de visiteurs
depuis le : 12/11/2008

Aujourd'hui:438
En ligne :3
Max. en ligne:312
Max. / jour:66 529
Total hier:3 304
Total ce mois:44 800
Total visites:20 209 203
Moyenne/jour:5 672

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 10553 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
R15010 [VBA] Où sont les macros ?, R12060 Répondre à une invitation, R99190 Vieille souris, R18010 Synchroniser un PDA avec un compte Exchange, R08140 Interface non enregistrée ou interface non prise en charge, R99230 Sourire, R03110 Déplacer les messages lors de l'envoi, R04070 Rendre visible le dossier temporaire des pièces jointes, R15020 [VBA] Incorporer votre code HTML dans votre mail, R08210 Message d'erreur : Le client de courrier électronique par défaut n'est pas correctement installé, R08210 Message d'erreur : Le client de courrier électronique par défaut n'est pas correctement installé, R03070 Créer son papier à lettres personnel, R04020 Insérer un élément d'Outlook dans un message, R15260 [VBA] Copier le corps et les en-têtes vers le presse-papier, R01130 Choisir l'éditeur de 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 [/\]