Discussion :

[davido84]

Bonjour,

l'utilisation de l'objet File System Object permet notamment la manipulation des dossiers.

L'utilisation de la méthode Copy associée à la méthode GetFolder permet de dupliquer d'un bloc le dossier source, ses sous-dossiers et les fichiers que les dossiers contiennent.

Il arrive cependant qu'un dossier contienne une icône personnalisée, lui permettant un affichage distinctif (pour personnaliser l'affichage du dossier : clic droit sur le dossier>"Propriétés">onglet "Personnaliser"'>"Changer d'icône">choisir une icône>clic sur le bouton OK>clic sur le bouton OK).

Dans le cas où le dossier est personnalisé, celui-ci n'est pas activé lors de sa duplication.

Je vous livre donc une procédure qui permet l'affichage personnalisé des dossiers lors de leur duplication.

Pour les besoins de la démonstration :
- le dossier source (contenant le dossier maître, ses sous-dossiers et les fichiers que les dossiers contiennent) doit être placé sur le bureau et doit être nommé "dossier_source" ;
- le dossier dupliqué sera créé sur le bureau lors du lancement de la procédure et sera nommé "dossier_dupliqué".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
 
'Activer les references Microsoft Scripting RunTime et Windows Script Host Object Model
'si utilisation de liaison anticipée.
 
 
Option Explicit
 
Dim oFSO As Object 'New FileSystemObject
Const SourceFolderName As String = "dossier_source" 'nom du dossier source
Const DuplicFolderName As String = "dossier_dupliqué" 'nom du dossier dupliqué
 
Sub DuplicateCustomFolders()
  Dim SourceFolderPath As String
  Dim DuplicFolderPath As String
 
  SourceFolderPath = GetDesktopFolder & "\" & SourceFolderName 'chemin sur le bureau du dossier source
  DuplicFolderPath = GetDesktopFolder & "\" & DuplicFolderName 'chemin sur le bureau du futur dossier dupliqué
 
  Set oFSO = CreateObject("Scripting.FileSystemObject") 'New Scripting.FileSystemObject
  'si le dossier source n'est pas détecté on stoppe la procédure
  If Not oFSO.FolderExists(SourceFolderPath) Then MsgBox "Dossier source non trouvé": GoTo fin
  'si le dossier dupliqué existe on le supprime
  If oFSO.FolderExists(DuplicFolderPath) Then oFSO.DeleteFolder (DuplicFolderPath)
  'on crée le dossier dupliqué contenant l'intégralité du dossier source mais à ce stade
  'les dossiers dupliqués ne sont pas personnalisés lorsque "dossier_dupliqué" est créé
  oFSO.GetFolder(SourceFolderPath).Copy DuplicFolderPath, False
  'activation des fichiers desktop.ini pour personnaliser les dossiers dupliqués
  DesktopIni DuplicFolderPath
 
fin:
  Set oFSO = Nothing
End Sub
 
 
'structure récursive inspirée d'un code d'AlainTech
Sub DesktopIni(strFolderName As String)
  Dim oFolder As Object 'Scripting.Folder
  Dim oSubFolder As Object 'Scripting.Folder
 
  Set oFolder = oFSO.GetFolder(strFolderName)
 
  If oFSO.FileExists(strFolderName & "\desktop.ini") Then
      'Le dossier possède un attribut système
      SetAttr oFolder.Path, vbSystem
      'Le fichier desktop.ini possède les attributs système et caché
      SetAttr oFolder.Path & "\desktop.ini", vbSystem + vbHidden
  End If
 
  For Each oSubFolder In oFolder.SubFolders
      DesktopIni oSubFolder.Path
  Next oSubFolder
 
 
End Sub
 
 
'Récupère le chemin du bureau
Function GetDesktopFolder() As String
  Dim oShell As Object 'WshShell
  Set oShell = CreateObject("WScript.Shell") 'New WshShell
  GetDesktopFolder = oShell.SpecialFolders("Desktop")
End Function

Procédure testée avec succès sur Windows10/Excel 2010 64 bits et Windows7/Excel 2007.

A adapter de votre côté si l'emplacement du dossier source et/ou celui du dossier dupliqué ne sont pas placés sur le bureau.

Je suis parti du principe que vous pouviez construire vous-même un dossier maître personnalisé contenant des sous-dossiers personnalisés ou non (et éventuellement des fichiers) mais je peux éventuellement en joindre un si vous le jugez utile.

N'hésitez pas à me faire part de vos remarques et à me communiquer le résultat de vos tests en indiquant votre configuration version Windows/version d'Excel.

A+

[davido84]

Code de la Sub DesktopIni simplifié (modification faite dans le code du post #1).
A+

[davido84]

Si le dossier source et le dossier dupliqué ne sont pas au même endroit (ou même s'ils le sont d'ailleurs) : indiquer les chemins complets dans les variables SourceFolderPath et DuplicFolderPath

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Dim oFSO As Object 
 
Sub DuplicateCustomFolders()
  Dim SourceFolderPath As String
  Dim DuplicFolderPath As String
 
  SourceFolderPath = "C:\dossier_source" 'chemin complet du dossier source à adapter
  DuplicFolderPath = "C:\xxx\xxx\xxx\dossier_dupliqué"  'chemin complet du dossier dupliqué à adapter
 
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  'si le dossier source n'est pas détecté on stoppe la procédure
  If Not oFSO.FolderExists(SourceFolderPath) Then MsgBox "Dossier source non trouvé": GoTo fin
  'si le dossier dupliqué existe on le supprime
  If oFSO.FolderExists(DuplicFolderPath) Then oFSO.DeleteFolder (DuplicFolderPath)
  'on crée le dossier dupliqué contenant l'intégralité du dossier source mais à ce stade
  'les dossiers dupliqués ne sont pas personnalisés lorsque "dossier_dupliqué" est créé
  oFSO.GetFolder(SourceFolderPath).Copy DuplicFolderPath, False
  'activation des fichiers desktop.ini pour personnaliser les dossiers dupliqués
  DesktopIni DuplicFolderPath
 
fin:
  Set oFSO = Nothing
End Sub
 
 
Sub DesktopIni(strFolderName As String)
  Dim oFolder As Object
  Dim oSubFolder As Object
 
  Set oFolder = oFSO.GetFolder(strFolderName)
  If oFSO.FileExists(strFolderName & "\desktop.ini") Then
      'Le dossier possède un attribut système
      SetAttr oFolder.Path, vbSystem
      'Le fichier desktop.ini possède les attributs système et caché
      SetAttr oFolder.Path & "\desktop.ini", vbSystem + vbHidden
  End If
 
  For Each oSubFolder In oFolder.SubFolders
      DesktopIni oSubFolder.Path
  Next oSubFolder
 
End Sub

A+

[patricktoulon]

Bonjour Davido

une petite variante bien sympathique
je te laisse regarder

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Option Explicit
Sub test()
    Dim dossier1, dossierDest
    dossier1 = "C:\Users\polux\Desktop\dossier1"
    dossierDest = "C:\Users\polux\Desktop\general\"
    move_copyfolder dossier1, dossierDest, 2, "dossiercopié"
    ' 1 ou "copie" pour copier
    ' 2 ou "move" pour deplacer
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function move_copyfolder(dossier1, dossierDest, action As Variant, Optional Newname As String = "")
    Dim FSO As Object, oldName As String   'declaration object et creation object late binding
    Set FSO = CreateObject("Scripting.FileSystemObject")
    oldName = StrReverse(Split(StrReverse(dossier1), "\")(0))    'on recupere le nom court du dossier
    Newname = IIf(Newname <> "", Newname, oldName)    'si newname est différent de rien alors  on change le nom du dossier
    Select Case action
    Case "copie", 1
        ' copier Un repertoire
        FSO.CopyFolder dossier1, dossierDest & Newname
        SetAttr dossierDest & Newname, vbSystem
        SetAttr dossierDest & Newname & "\desktop.ini", vbSystem + vbHidden
    Case "move", 2
        'Déplacer un répertoire
        FSO.MoveFolder dossier1, dossierDest & Newname
    End Select
End Function

[davido84]

Bonjour Patrick,

envisager la possibilité de déplacer le dossier, pourquoi pas.

Par contre ta procédure ne tient compte uniquement de la personnalisation du dossier maître.

Elle ne fonctionne pas :
- si le dossier maître n'est pas personnalisé
- si le dossier maître contient des sous-dossiers de niveau 1 ou 2 ou + qui sont (ou pas) personnalisés (seul le dossier maître est traité).

D'où l'intérêt de prévoir pour chaque dossier une condition testant l'existence d'un fichier desktop.ini

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If oFSO.FileExists(strFolderName & "\desktop.ini") Then

et l'utilisation d'une procédure visant à rechercher l'existence d'éventuels sous-dossiers de niveau 1, 2,... sur lesquels il faudra également tester l'existence d'un fichier desktop.ini (c'est pourquoi j'utilise une procédure récursive).

A+

[patricktoulon]

re
je pense que l'on peut se passer du "scriptingfillsystem"
puisque qu'avec "dir" on peut tester le getattrt on doit pouvoir appliquer "setattr" non ?????
si oui j'ai les bases et en récursive

[davido84]

je pense que l'on peut se passer du "scriptingfillsystem"

L'intérêt du FSO est notamment l'utilisation de méthodes qui te permettent d'obtenir la collection des dossiers à partir d'un dossier maître, de cibler directement un dossier ou un sous-dossier, etc.

Maintenant si tu penses que c'est mieux de passer par Dir, propose une solution pour voir si elle est fonctionnelle et plus simple d'utilisation.
A+

[patricktoulon]

Bonjour davido
j'ai repris ma macro recursive pour chercher un fichier et je l'ai adapté a ton sujet

j'ai un seul petit soucis je suis obligé de passer en force dans la boucle for... a la fin avec " on error " car le test sur dir(....)="" ou <>"" donne le même résultat

je n'ai pas intégré la copie ou le déplacement mais en fin l'idée est là

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub test2()
    Dim chemin, mesdossier
    chemin = "C:\Users\polux\Desktop\general"    ' racine pour la recherche
    mesdossier = dossier_icon_personalisé(chemin)    '  ||mesfichier|| deviendra un tableau de nom de fichiers selon les condition précédemment énumérée
    If UBound(mesdossier) > 0 Then MsgBox Join(mesdossier, vbCrLf)  'exemple te liste les dossiers  dans un msgbox avec join
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function dossier_icon_personalisé(dossier, Optional texte As String) As Variant
    Dim chemin As String, itemsvu As String, nbitemsVu As Long, i As Long
    chemin = dossier & "\"
    itemsvu = Dir(chemin, vbDirectory)
    Do
        nbitemsVu = nbitemsVu + 1
        If itemsvu <> "." And itemsvu <> ".." Then
            If (GetAttr(chemin & itemsvu) And vbDirectory) = vbDirectory Then    'teste si c'est un dossier
                Call dossier_icon_personalisé(chemin & itemsvu, texte)    'utilisation de la récursivité
                   texte = texte & vbCrLf & chemin & itemsvu
            End If
            itemsvu = Dir(chemin, vbDirectory)
            For i = 1 To nbitemsVu - 1: itemsvu = Dir: Next i    ' replacement du dir sur le bon flag ( dir a la base n'est pas récursif)
        End If
        itemsvu = Dir
    Loop While itemsvu <> ""
    mesdoss = Split(texte, vbCrLf)
    'je remplace ta boucle sur les subfolder par une boucle sur tout les dossiers et subdossier confondus
    For i = 0 To UBound(mesdoss)
        On Error Resume Next
                SetAttr mesdoss(i), vbSystem
                SetAttr mesdoss(i) & "\desktop.ini", vbSystem + vbHidden       'Le fichier desktop.ini possède les attributs système et caché
           On Error GoTo 0
    Next
    dossier_icon_personalisé = mesdoss
End Function

j'attend ton retour

pour indice j'ai placer avant de poster des debug.print partout et il y a des truc bizarres qui se passent
notament dans le do/loop la variable text prend unique ment les dossiers
quand je split le text je me retrouve avec des items en plus c'est pour ca les conditions dans la boucle for .....

vraiment surprenant !!!

[davido84]

J'ai testé mes la fonction ne ramène rien (mesdoss est vide).
De toutes les manières même si cela fonctionne je trouve le principe bien plus alambiqué qu'en utilisant le FSO.

Avec le FSO :
1 le dossier maître et tout son contenu sont copiés d'un seul coup
2 chaque dossier est directement ciblé
3 dans chaque dossier l'existence d'un fichier desktop.ini est testé directement

Franchement je ne vois pas l'intérêt de se passer du FSO, ne serait-ce que pour le premier point

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

oFSO.GetFolder(SourceFolderPath).Copy DuplicFolderPath, False

A+