Discussion :

[ccensam]

Bonjour,

J'ai un fichier Excel qui contient une seule feuille nommée "Rep", elle contient 2 Colonnes :

• Colonne 1 : contient le chemin complet vers un répertoire
• Colonne 2 : après exécution d'une la macro doit contenir la taille totale du répertoire de la colonne 1

Je ne suis pas un fan de excel ni de VBA, veuillez m'aider svp à créer cette macro qui remplit la colonne 2 avec la taille du répertoire dans le chemin complet et dans la colonne 1.

Très amicalement,

---
HAMDAOUI Mohamed Amine
Ingénieur Produit - YMO

[kiki29]

Salam, cela devrait te convenir

[ccensam]

Votre fichier est très intéressant, est ma donné l'idée de la façon avec laquelle je peux résoudre le problème! J'ai essayé de le modifier avec mes connaissances basique en VBA ! Mais j'ai quelques problèmes et difficultés (compilation) pour arriver à mon but.

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
Sub Tst()
    Dim i As Long
    Dim FSO As Scripting.FileSystemObject
    Dim Dossier As Scripting.Folder
 
    Set FSO = New Scripting.FileSystemObject
 
    For i = 1 To 10
        Set Dossier = FSO.GetFolder(Feuil1.Cells(iRow, 1))
        Feuil1.Cells(iRow, 2).Value = Dossier.Size
    Next
 
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub

Mon but est plus simple : j'ai les chemins complets (dans la première colonne) vers les dossiers dont je veux connaitre la taille ==> Une fois je clique sur le bouton la macro remplie automatiquement la deuxième colonne.

PS : dans mon code j'ai supposé qu'il y a 10 colonnes! à améliorer dans le futur.

Cordialement,

[kiki29]

Salut, dans ce cas un conseil tout de même vérifier l'existence du dossier
et sous VBE dans Outils/References Cocher Microsoft Scripting Runtime

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
 
Sub Tst2()
Dim iRow As Long, LastRow As Long, sChemin As String
Dim FSO As Scripting.FileSystemObject
Dim Dossier As Scripting.Folder
 
    LastRow = ShDatas.Range("A" & Rows.Count).End(xlUp).Row
    ShDatas.Columns("B:B").Clear
 
    Application.ScreenUpdating = False
 
    Set FSO = New Scripting.FileSystemObject
 
    For iRow = 1 To LastRow
        sChemin = ShDatas.Cells(iRow, 1)
        If ExistenceDossier(sChemin) = True Then
            Set Dossier = FSO.GetFolder(sChemin)
            ShDatas.Cells(iRow, 2) = Dossier.Size
        End If
    Next iRow
 
    Application.ScreenUpdating = True
 
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub
 
Private Function ExistenceDossier(NomDossier As String) As Boolean
    ExistenceDossier = Dir(NomDossier, vbDirectory) <> "" And Len(NomDossier) > 0
End Function

sinon

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
Sub Tst3()
Dim iRow As Long, LastRow As Long, sChemin As String
Dim FSO As Object
Dim Dossier As Object
 
    LastRow = ShDatas.Range("A" & Rows.Count).End(xlUp).Row
    ShDatas.Columns("B:B").Clear
 
    Application.ScreenUpdating = False
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    For iRow = 1 To LastRow
        sChemin = ShDatas.Cells(iRow, 1)
        If ExistenceDossier(sChemin) = True Then
            Set Dossier = FSO.GetFolder(sChemin)
            ShDatas.Cells(iRow, 2) = Dossier.Size
        End If
        Application.StatusBar = iRow
    Next iRow
 
    Application.ScreenUpdating = True
 
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub
 
Private Function ExistenceDossier(NomDossier As String) As Boolean
    ExistenceDossier = Dir(NomDossier, vbDirectory) <> "" And Len(NomDossier) > 0
End Function

[ouskel'n'or]

Le même
Valider Microsoft Scripting Runtime -> dans l'éditeur VB -> Outils -> References

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
Sub TailleRep()
Dim Rep As String, Chemin As String, fso
Dim LeRep As Scripting.Folder
    Set fso = CreateObject("Scripting.FileSystemObject")
    Chemin = "D:\"
    Rep = Dir(Chemin, vbDirectory)
    Do While Len(Rep) > 0
        If (GetAttr(Chemin & Rep) And vbDirectory) = vbDirectory Then
            i = i + 1
            Cells(i, 1) = Chemin & Rep
            Set LeRep = fso.GetFolder(Cells(i, 1).Value)
            Cells(i, 2) = LeRep.Size
        End If
        Rep = Dir()
    Loop
End Sub