Tri automatique des sous-dossiers

Version imprimable

03/10/2016, 11h05
don_pets

Tri automatique des sous-dossiers

Bonjour le fofo,

J'ai, grâce à l'intervention de plusieurs champions, créée une macro qui crée des répertoires et transfère automatiquement des mails dedans.

La dessus, tout fonctionne.

Ma question est : Comment puis-je procéder pour qu'une fois le répertoire créée, il se classement automatiquement par ordre alphabétique ?

Merci,

Pet's
03/10/2016, 12h48
Jean-Philippe André

Salut,

sauf erreur de ma part, les dossiers se classent deja automatiquement par ordre alphabetique :)

Citation:

Envoyé par Jean-Philippe André

Salut,

sauf erreur de ma part, les dossiers se classent deja automatiquement par ordre alphabetique :)

Héééé non, ce serait trop simple,

En fait ma macro me propose après sélection d'un ou plusieurs mails, de les déplacer dans un dossier existant ou d'en créer un nouveau. Si je prends cette deuxième option le dossier fraichement créée, il se placera automatiquement en tête de liste. Et comme j'en créée un certain nombre, cela peut vite devenir pénible de s'y retrouver.

D'où la ligne code que je souhaiterai rajouter afin que ma macro suite à la création du dossier face un tri auto (en gros le clic droit qui donne trier automatiquement les dossiers de A à Z)

Pour info, voici un bout du code que j'utilise :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 ' Déplacement des Mails Dim MonApply As Outlook.Application Dim MaTache As Outlook.TaskItem Dim MonMail As Outlook.MailItem Dim MonNSpace As Outlook.namespace Dim FldDossier As Outlook.Folder Dim monRepDest As Outlook.MAPIFolder Dim strObjet As String Dim strTitre As String Dim MaSelection As Outlook.Selection Set MonApply = Outlook.Application Set MonNSpace = MonApply.GetNamespace("MAPI") Set FldDossier = MonNSpace.GetDefaultFolder(olFolderInbox) ' Récupère tous les mails sélectionnés Set MaSelection = MonApply.ActiveExplorer.Selection nbmail = MaSelection.Count ' Demande dans quel répertoire sauvegarder les mails et archive les mails Set monRepDest = MonNSpace.PickFolder If TypeName(monRedDest) <> "Nothing" Then For Each MonMail In MaSelection MonMail.Move monRepDest Next MonMail End If
Pet's

Salut,
Ton besoin est en fait différent de ce que tu expliquais au début, je pense que le code suivant peu y répondre juste en actualisant la fenetre en question

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Public Sub refresh_explorer(rep)
'---------------------------------------------------------------------------------------
' Procedure : refresh_explorer
' Author    : Oliv
' Date      : 18/02/2016
' Purpose   : rafraichie l'explorateur ouvert sur le dossier passé en argument
' AJOUTER UNE REFERENCE à 'Microsoft Internet control'
'---------------------------------------------------------------------------------------
'
 
'find the right internet explorer webpage
    Dim allExplorerWindows As New SHDocVw.ShellWindows
    Dim IEwindow As Object
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    AFolder = FSO.GetParentFolderName(rep)
 
    Set allExplorerWindows = New SHDocVw.ShellWindows
    AFolder = Replace(AFolder, "\", "/")
    For Each IEwindow In allExplorerWindows
        Debug.Print IEwindow.LocationURL
        If InStr(IEwindow.LocationURL, AFolder) <> 0 Then
            IEwindow.Refresh
            'on peut quitter au premier trouvé
            'exit for
        End If
    Next
End Sub
 
Sub Test_refresh_explorer()
 
    Call refresh_explorer(PathNomExport)
 
End Sub