Discussion :

[SMIET]

Salut,

Avec une Macro Excel, je voudrais ouvrir une boite de dialogue pour avoir le chemin d'un dossier et avoir sa taille en octet ("Taille sur le disque" si possible)
et que cela m'insère le chemin et le nom du dossier et la taille en octet dans des cellules séparées.

Taille sur le disque (Si possible)


Je n'arrive pas à trouver…

J'ai cette macro qui fonctionne pour ouvrir le chemin sur le disque dur

Code :

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

1
2
3
Sub Ouvrir_Boite_Dialogue()
    Application.FileDialog(msoFileDialogFolderPicker).Show
End Sub

J'ai cette macro qui fonctionne pour avoir la taille du dossier en octet

Code :

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

1
2
3
4
5
Sub NombreOctetsRepertoire()
Dim Rep As Object
Set Rep = CreateObject("Scripting.FileSystemObject")
Range("A1") = Rep.GetFolder("C:\ Program Files\MON PROG").Size
End Sub

Je n'arrive pas à combiner les 2 macros pour que je puisse ouvrir le dossier et que cela m'insère le chemin du dossier dans une cellule
et la taille en octet dans une autre en m'insérant le chemin dans :

Code :

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

Range("A1") = Rep.GetFolder("le chemin du dossier de Ouvrir_Boite_Dialogue").Size

Si quelqu'un a ça ou similaires…

Merci

@+

[tototiti2008]

Bonjour,

Sans doute un truc du genre

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub test()
Dim FD as Filedialog, ChemDoss as string, Taille, FSO as Object
Set FD = application.FileDialog(msoFileDialogFolderPicker)
if Fd.show<>0 then 
chemdoss = fd.selecteditems(1)
set FSO = createobject("Scripting.FileSystemObject")
Taille = fso.GetFolder(chemdoss).size
end if
set fso = nothing
set fd = nothing
range("A1").value = chemdoss
range("B1").value = taille
end sub

[deedolith]

Salut,

Les boites de dialogue standard ne proposant pas cette fonctionnalité, tu auras besoin de créer un formulaire.

Quand à la taille d'un dossier, comme te l'indique tototiti2008, c'est l'objet Scripting.Folder (issu de la librairie Scripting.FileSystemObject) qui te la donnera.

[SMIET]

Bonjour,

Sans doute un truc du genre

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub test()
Dim FD as Filedialog, ChemDoss as string, Taille, FSO as Object
Set FD = application.FileDialog(msoFileDialogFolderPicker)
if Fd.show<>0 then 
chemdoss = fd.selecteditems(1)
set FSO = createobject("Scripting.FileSystemObject")
Taille = fso.GetFolder(chemdoss).size
end if
set fso = nothing
set fd = nothing
range("A1").value = chemdoss
range("B1").value = taille
end sub

Salut,

Merci à vous deux, ça fonctionne.

J'ai juste un problème de droit sur certains dossiers...



Est ce qu'il y a un moyen de l’intégré à la macro sans être obligé de le faire en passant par Windows "Propriétés" -> Sécurité" -> (Ect.)

Merci

[tototiti2008]

Bonjour,

Pas à ma connaissance

[patmeziere]

Bonjour
à ma connaissance oui
en fait il est vrai que le FSO est puissant mais limité avec les dossiers spéciaux puisque ils ne lui sont pas autorisés
alors on va chercher un autre object qui est le "shell.application"
mais la on a un soucis c'est que le getdetailOf n'est pas accessible pour les dossier c'est ballo!!
que cela te tienne on va récupérer la taille des élément du contenu
bien sur ça fonctionnera avec uniquement des fichiers à l’intérieur les sous dossiers ne seront pas pris en compte

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
Sub Test()
    Dim FD As FileDialog, ChemDoss$, shello As Object, objFolder As Object, bjFolderItem As Object, objSubFolder As Object
    Dim objFile As Object, totalSize#
 
    ' Ouvrir le sélecteur de dossier
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    If FD.Show <> 0 Then
        ChemDoss = FD.SelectedItems(1)
 
        ' Initialiser Shell.Application pour parcourir le dossier
        Set shello = CreateObject("Shell.Application")
        Set objFolder = shello.Namespace(ChemDoss & "\")
 
        totalSize = 0 ' Initialiser la taille totale
 
        ' Parcourir les fichiers et sous-dossiers pour calculer la taille
        For Each objFile In objFolder.Items
            On Error Resume Next
            If Not objFile.IsFolder Then
                totalSize = totalSize + objFile.Size
            End If
            On Error GoTo 0
        Next objFile
 
        ' Afficher la taille totale en octets
        MsgBox "La taille du dossier est de : " & Format(totalSize, "#,##0") & " octets"
 
        ' Facultatif : Insérer la taille dans une cellule Excel
        Range("A1").Value = ChemDoss
        Range("B1").Value = totalSize
    End If
 
    ' Nettoyage
    Set objFolder = Nothing
    Set shello = Nothing
    Set FD = Nothing
End Sub

si l'on doit prendre les sous dossiers en compte il faudra passer en examen récursif

[tototiti2008]

Bonjour,

Sur la base de la solution de patmeziere, avec récursivité
Sur les gros dossiers il ne faut pas être pressé

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
Sub Test()
    Dim FD As FileDialog, ChemDoss$, shello As Object, ObjFolder As Object
    Dim ObjFile As Object, totalSize#
 
    ' Ouvrir le sélecteur de dossier
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    If FD.Show <> 0 Then
        ChemDoss = FD.SelectedItems(1)
 
        ' Initialiser Shell.Application pour parcourir le dossier
        Set shello = CreateObject("Shell.Application")
        Set ObjFolder = shello.Namespace(ChemDoss & "\")
 
        ' Parcourir les fichiers et sous-dossiers pour calculer la taille
        totalSize = FolderSize(ObjFolder)
 
        ' Afficher la taille totale en octets
        MsgBox "La taille du dossier est de : " & Format(totalSize, "#,##0") & " octets"
 
        ' Facultatif : Insérer la taille dans une cellule Excel
        Range("A1").Value = ChemDoss
        Range("B1").Value = totalSize
    End If
 
    ' Nettoyage
    Set ObjFolder = Nothing
    Set shello = Nothing
    Set FD = Nothing
End Sub
 
Function FolderSize(ObjFolder As Object) As Double
Dim ObjFile As Object
    FolderSize = 0
    For Each ObjFile In ObjFolder.Items
    'On Error Resume Next
        If ObjFile.IsFolder Then
            FolderSize = FolderSize + FolderSize(ObjFile.getfolder)
        Else
            FolderSize = FolderSize + ObjFile.Size
        End If
    'On Error GoTo 0
    Next ObjFile
End Function

[patmeziere]

Bonjour tototiti2008

avertir l'utilisateur quand même que la gestion d'erreur n'est pas là pour rien et qu'en cas d'erreur 70,52,64
les sous dossiers ne seront pas lu et donc le résultat ne reflètera que ce qui est accessible via vba

effectivement le prix ;c'est le temps d’exécution sur de gros dossiers

[Invité]

Bref, une fonction qui renvoie la taille du dossier ça n'existe pas il faut le faire soi-même récursivement et même GetFolder().size le fait en interne c'est plus visible avec les gros volume donc pour consulter de temps un temps un dossier de quelques centaines de fichiers ça ne poste pas problème mais pour construire un arbre ou parcourir des lecteurs surement ce n'est pas la bonne solution.