Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de
discussion :
ujrBbfGEKHA.4316@TK2MSFTNGP04.phx.gbl...
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" a écrit dans le message de news:Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OPpHoxGEKHA.4608@TK2MSFTNGP02.phx.gbl...
Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de
discussion :
ujrBbfGEKHA.4316@TK2MSFTNGP04.phx.gbl...
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" a écrit dans le message de news:Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" a écrit dans le message de news:Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OPpHoxGEKHA.4608@TK2MSFTNGP02.phx.gbl...
Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de
discussion :
ujrBbfGEKHA.4316@TK2MSFTNGP04.phx.gbl...
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" a écrit dans le message de news:Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
> Dis moi, quoi vouloir de plus ?
Si tu ne veux que les fichiers soient dans excel, que ta volonté soit
faite !
;-)
dir c:*.xls* /s/n/o >c:Test.xls
à la limite, tu peux même actionner la commande à partir d'une macro :
'----------------------------------
Sub Afficher_les_Fichiers_Excel()
Shell "command.com /c dir c:*.xls /s/b >C:test.xls", vbHide
End Sub
'----------------------------------
Dis moi, quoi vouloir de plus ?
;-))
"garnote" a écrit dans le message de groupe de
discussion :
C'est OK pour le fichier texte mais là, j'en ai plus que voulu.
Je ne veux que les fichiers .xls avec nombre et taille.
J'aimerais bien que ça prenne une forme un peu semblable
à celle obtenue par mes macros.
Mais bon, ce n'est pas grave. Ce n'était qu'un exercice de VBA
pour explorer les répertoires.
Merci et A+
Moé
"garnote" a écrit dans le message de news:
%Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" a écrit dans le message de news:Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
> Dis moi, quoi vouloir de plus ?
Si tu ne veux que les fichiers soient dans excel, que ta volonté soit
faite !
;-)
dir c:*.xls* /s/n/o >c:Test.xls
à la limite, tu peux même actionner la commande à partir d'une macro :
'----------------------------------
Sub Afficher_les_Fichiers_Excel()
Shell "command.com /c dir c:*.xls /s/b >C:test.xls", vbHide
End Sub
'----------------------------------
Dis moi, quoi vouloir de plus ?
;-))
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de
discussion :
u14yGMHEKHA.1516@TK2MSFTNGP05.phx.gbl...
C'est OK pour le fichier texte mais là, j'en ai plus que voulu.
Je ne veux que les fichiers .xls avec nombre et taille.
J'aimerais bien que ça prenne une forme un peu semblable
à celle obtenue par mes macros.
Mais bon, ce n'est pas grave. Ce n'était qu'un exercice de VBA
pour explorer les répertoires.
Merci et A+
Moé
"garnote" <garnote3@videotron.ca> a écrit dans le message de news:
%23GXZGCHEKHA.1376@TK2MSFTNGP02.phx.gbl...
Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OPpHoxGEKHA.4608@TK2MSFTNGP02.phx.gbl...
Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de
discussion :
ujrBbfGEKHA.4316@TK2MSFTNGP04.phx.gbl...
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
> Dis moi, quoi vouloir de plus ?
Si tu ne veux que les fichiers soient dans excel, que ta volonté soit
faite !
;-)
dir c:*.xls* /s/n/o >c:Test.xls
à la limite, tu peux même actionner la commande à partir d'une macro :
'----------------------------------
Sub Afficher_les_Fichiers_Excel()
Shell "command.com /c dir c:*.xls /s/b >C:test.xls", vbHide
End Sub
'----------------------------------
Dis moi, quoi vouloir de plus ?
;-))
"garnote" a écrit dans le message de groupe de
discussion :
C'est OK pour le fichier texte mais là, j'en ai plus que voulu.
Je ne veux que les fichiers .xls avec nombre et taille.
J'aimerais bien que ça prenne une forme un peu semblable
à celle obtenue par mes macros.
Mais bon, ce n'est pas grave. Ce n'était qu'un exercice de VBA
pour explorer les répertoires.
Merci et A+
Moé
"garnote" a écrit dans le message de news:
%Ave Denis,
Ma nullité DOS est sans bornes :-(
Voici ma question :
http://www.cijoint.fr/cjlink.php?file=cj200907/cijpMtdP82.xls
Serge
"MichDenis" a écrit dans le message de news:Bonjour Garnote,
Pourquoi ne pas le faire en DOS
Tu ouvres une fenêtre DOS et tu tapes :
dir c: /S >c:Test.txt
ça va prendre quelques secondes et le tout est joué.
tout va être affiché dans ton fichier test.txt
Si tu tapes dir /? dans la fenêtre DOS, tu vas avoir tous les
commutateurs possibles.
"garnote" a écrit dans le message de groupe de
discussion :
Bonjour,
J'aimerais obtenir, sous une forme "agréable à consulter",
pour chaque répertoire et sous-répertoire de mes disques C et D,
le nombre et la taille totale de tous ses fichiers Excel.
Je ne suis pas très familier avec ce genre de chose.
Voici le début de mes timides efforts pour y arriver.
Sans devenir fou, peut-on automatiser tout ça ? :-)
Sub ListeRep()
rep = "D:" 'ou "D:Données ou ...
[A:B].ClearContents
Cells(1, 1) = rep
Cells(1, 1).Font.Bold = True
NomRep = Dir(rep, vbDirectory)
i = 2
Do While NomRep <> ""
If NomRep <> "." And NomRep <> ".." Then
If (GetAttr(rep & NomRep) And vbDirectory) = vbDirectory Then
Cells(i, 1) = NomRep
i = i + 1
End If
End If
NomRep = Dir
Loop
Columns("A:A").EntireColumn.AutoFit
End Sub
Sub nfxls()
Columns("A:B").ClearContents
rep = "D:Données"
nf = Dir("*.xls")
Do While nf <> ""
t = t + FileLen(rep & "" & nf)
n = n + 1
nf = Dir()
Loop
Cells(1, 1) = "Répertoire"
Cells(1, 2) = rep
Cells(2, 1) = "Nombre"
Cells(2, 2) = n
Cells(3, 1) = "Taille"
Cells(3, 2) = Format((t / 1000000), "0.00") & " Mo"
Columns("A:B").EntireColumn.AutoFit
End Sub
Serge
Et pour faire simple, il y a aussi ceci :
Différents bouts de code réunis dont un bout
de code publié sur le site de Frédéric Sigonneau.
'Variable dans le haut du module
Dim I As Integer
'-------------------------------------------------------
Sub TestGetFiles()
Dim Sh As Worksheet
Dim varItem As Variant
Dim strDirPath As String
Dim Répertoire_Par_Défaut As String
Répertoire_Par_Défaut = "C:UsersDM" 'à définir
If Dir(Répertoire_Par_Défaut) = "" Then
MsgBox "Chemin inexistant. Opération annulée."
Exit Sub
End If
I = 1
strDirPath = ChoixDossier(Répertoire_Par_Défaut)
Application.ScreenUpdating = False
Set Sh = Sheets.Add
If GetFiles(strDirPath, Sh, True) Then
EnTetes = Array("Chemin", "Nom", _
"Date création", "Date dernière modification", _
"Date dernier accès", "Taille", "Type", "Attribut(s)")
With Sh.Range("A1:H1")
.Value = EnTetes
.Font.Bold = True
.Interior.ColorIndex = 43
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End If
With Sh
With .Range("A1:H1")
.EntireColumn.AutoFit
End With
With .Range("A1:H" & .Range("A65536").End(xlUp).Row)
.Sort key1:=Sh.Range("A2"), order1:=xlAscending, Header:=xlYes
End With
End With
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------
Function GetFiles(strPath As String, _
Sh As Worksheet, _
Optional blnRecursive As Boolean) As Boolean
Dim fsoSysObj As Object
Dim fdrFolder As Object
Dim fdrSubFolder As Object
Dim filFile As Object
If strPath = "C:UsersDMDocumentstest" Then Stop
Set fsoSysObj = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
GetFiles = False
GoTo GetFiles_End
End If
Err.Clear
For Each filFile In fdrFolder.Files
Select Case LCase(Split(filFile, ".")(1))
Case Is = "xls", "xlt", "xlb", "xlm", "xlsx", "xlxm", "xltx", "xlsb"
I = I + 1
With filFile
ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated, _
.DateLastModified, .DateLastAccessed, .Size, .Type)
End With
Sh.Cells(I, 1). _
Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
Sh.Cells(I, UBound(ArrFSO) + 2).Value = Attributs(File.Attributes)
End Select
Next filFile
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, Sh, True
Next fdrSubFolder
End If
GetFiles = True
GetFiles_End:
Exit Function
End Function
'---------------------------------------------
Function Attributs(Attrib)
Dim Res$
If Attrib = 0 Then Res = "Aucun attribut"
If Attrib And 1 Then Res = Res & "/Lecture seule"
If Attrib And 2 Then Res = Res & "/Caché"
If Attrib And 4 Then Res = Res & "/Système"
If Attrib And 32 Then Res = Res & "/Archive"
Attributs = Res
End Function
'---------------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Sélectionner le répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du répertoire.
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
'Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossier = Chemin
End Function
'---------------------------------------------
Et pour faire simple, il y a aussi ceci :
Différents bouts de code réunis dont un bout
de code publié sur le site de Frédéric Sigonneau.
'Variable dans le haut du module
Dim I As Integer
'-------------------------------------------------------
Sub TestGetFiles()
Dim Sh As Worksheet
Dim varItem As Variant
Dim strDirPath As String
Dim Répertoire_Par_Défaut As String
Répertoire_Par_Défaut = "C:UsersDM" 'à définir
If Dir(Répertoire_Par_Défaut) = "" Then
MsgBox "Chemin inexistant. Opération annulée."
Exit Sub
End If
I = 1
strDirPath = ChoixDossier(Répertoire_Par_Défaut)
Application.ScreenUpdating = False
Set Sh = Sheets.Add
If GetFiles(strDirPath, Sh, True) Then
EnTetes = Array("Chemin", "Nom", _
"Date création", "Date dernière modification", _
"Date dernier accès", "Taille", "Type", "Attribut(s)")
With Sh.Range("A1:H1")
.Value = EnTetes
.Font.Bold = True
.Interior.ColorIndex = 43
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End If
With Sh
With .Range("A1:H1")
.EntireColumn.AutoFit
End With
With .Range("A1:H" & .Range("A65536").End(xlUp).Row)
.Sort key1:=Sh.Range("A2"), order1:=xlAscending, Header:=xlYes
End With
End With
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------
Function GetFiles(strPath As String, _
Sh As Worksheet, _
Optional blnRecursive As Boolean) As Boolean
Dim fsoSysObj As Object
Dim fdrFolder As Object
Dim fdrSubFolder As Object
Dim filFile As Object
If strPath = "C:UsersDMDocumentstest" Then Stop
Set fsoSysObj = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
GetFiles = False
GoTo GetFiles_End
End If
Err.Clear
For Each filFile In fdrFolder.Files
Select Case LCase(Split(filFile, ".")(1))
Case Is = "xls", "xlt", "xlb", "xlm", "xlsx", "xlxm", "xltx", "xlsb"
I = I + 1
With filFile
ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated, _
.DateLastModified, .DateLastAccessed, .Size, .Type)
End With
Sh.Cells(I, 1). _
Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
Sh.Cells(I, UBound(ArrFSO) + 2).Value = Attributs(File.Attributes)
End Select
Next filFile
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, Sh, True
Next fdrSubFolder
End If
GetFiles = True
GetFiles_End:
Exit Function
End Function
'---------------------------------------------
Function Attributs(Attrib)
Dim Res$
If Attrib = 0 Then Res = "Aucun attribut"
If Attrib And 1 Then Res = Res & "/Lecture seule"
If Attrib And 2 Then Res = Res & "/Caché"
If Attrib And 4 Then Res = Res & "/Système"
If Attrib And 32 Then Res = Res & "/Archive"
Attributs = Res
End Function
'---------------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Sélectionner le répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du répertoire.
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
'Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossier = Chemin
End Function
'---------------------------------------------
Et pour faire simple, il y a aussi ceci :
Différents bouts de code réunis dont un bout
de code publié sur le site de Frédéric Sigonneau.
'Variable dans le haut du module
Dim I As Integer
'-------------------------------------------------------
Sub TestGetFiles()
Dim Sh As Worksheet
Dim varItem As Variant
Dim strDirPath As String
Dim Répertoire_Par_Défaut As String
Répertoire_Par_Défaut = "C:UsersDM" 'à définir
If Dir(Répertoire_Par_Défaut) = "" Then
MsgBox "Chemin inexistant. Opération annulée."
Exit Sub
End If
I = 1
strDirPath = ChoixDossier(Répertoire_Par_Défaut)
Application.ScreenUpdating = False
Set Sh = Sheets.Add
If GetFiles(strDirPath, Sh, True) Then
EnTetes = Array("Chemin", "Nom", _
"Date création", "Date dernière modification", _
"Date dernier accès", "Taille", "Type", "Attribut(s)")
With Sh.Range("A1:H1")
.Value = EnTetes
.Font.Bold = True
.Interior.ColorIndex = 43
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End If
With Sh
With .Range("A1:H1")
.EntireColumn.AutoFit
End With
With .Range("A1:H" & .Range("A65536").End(xlUp).Row)
.Sort key1:=Sh.Range("A2"), order1:=xlAscending, Header:=xlYes
End With
End With
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------
Function GetFiles(strPath As String, _
Sh As Worksheet, _
Optional blnRecursive As Boolean) As Boolean
Dim fsoSysObj As Object
Dim fdrFolder As Object
Dim fdrSubFolder As Object
Dim filFile As Object
If strPath = "C:UsersDMDocumentstest" Then Stop
Set fsoSysObj = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
GetFiles = False
GoTo GetFiles_End
End If
Err.Clear
For Each filFile In fdrFolder.Files
Select Case LCase(Split(filFile, ".")(1))
Case Is = "xls", "xlt", "xlb", "xlm", "xlsx", "xlxm", "xltx", "xlsb"
I = I + 1
With filFile
ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated, _
.DateLastModified, .DateLastAccessed, .Size, .Type)
End With
Sh.Cells(I, 1). _
Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
Sh.Cells(I, UBound(ArrFSO) + 2).Value = Attributs(File.Attributes)
End Select
Next filFile
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, Sh, True
Next fdrSubFolder
End If
GetFiles = True
GetFiles_End:
Exit Function
End Function
'---------------------------------------------
Function Attributs(Attrib)
Dim Res$
If Attrib = 0 Then Res = "Aucun attribut"
If Attrib And 1 Then Res = Res & "/Lecture seule"
If Attrib And 2 Then Res = Res & "/Caché"
If Attrib And 4 Then Res = Res & "/Système"
If Attrib And 32 Then Res = Res & "/Archive"
Attributs = Res
End Function
'---------------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Sélectionner le répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du répertoire.
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
'Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossier = Chemin
End Function
'---------------------------------------------
> Enfin quelque chose de simple! C'est vrai qu'en ligne commande, c'était un
peu difficile pour Serge ;-)
Bonjour à tous
Enfin quelque chose de simple! C'est vrai qu'en ligne commande, c'était un
peu difficile pour Serge ;-)
Rien que pour saisir ton code, Denis, je dois rajouter une barrette de
RAM ;-)
Bonne journée à vous 2.
Amicalement
J@@
MichDenis a écrit :Et pour faire simple, il y a aussi ceci :
Différents bouts de code réunis dont un bout
de code publié sur le site de Frédéric Sigonneau.
'Variable dans le haut du module
Dim I As Integer
'-------------------------------------------------------
Sub TestGetFiles()
Dim Sh As Worksheet
Dim varItem As Variant
Dim strDirPath As String
Dim Répertoire_Par_Défaut As String
Répertoire_Par_Défaut = "C:UsersDM" 'à définir
If Dir(Répertoire_Par_Défaut) = "" Then
MsgBox "Chemin inexistant. Opération annulée."
Exit Sub
End If
I = 1
strDirPath = ChoixDossier(Répertoire_Par_Défaut)
Application.ScreenUpdating = False
Set Sh = Sheets.Add
If GetFiles(strDirPath, Sh, True) Then
EnTetes = Array("Chemin", "Nom", _
"Date création", "Date dernière modification", _
"Date dernier accès", "Taille", "Type",
"Attribut(s)")
With Sh.Range("A1:H1")
.Value = EnTetes
.Font.Bold = True
.Interior.ColorIndex = 43
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End If
With Sh
With .Range("A1:H1")
.EntireColumn.AutoFit
End With
With .Range("A1:H" & .Range("A65536").End(xlUp).Row)
.Sort key1:=Sh.Range("A2"), order1:=xlAscending, Header:=xlYes
End With
End With
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------
Function GetFiles(strPath As String, _
Sh As Worksheet, _
Optional blnRecursive As Boolean) As Boolean
Dim fsoSysObj As Object
Dim fdrFolder As Object
Dim fdrSubFolder As Object
Dim filFile As Object
If strPath = "C:UsersDMDocumentstest" Then Stop
Set fsoSysObj = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
GetFiles = False
GoTo GetFiles_End
End If
Err.Clear
For Each filFile In fdrFolder.Files
Select Case LCase(Split(filFile, ".")(1))
Case Is = "xls", "xlt", "xlb", "xlm", "xlsx", "xlxm", "xltx",
"xlsb"
I = I + 1
With filFile
ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated,
_
.DateLastModified, .DateLastAccessed, .Size, .Type)
End With
Sh.Cells(I, 1). _
Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
Sh.Cells(I, UBound(ArrFSO) + 2).Value =
Attributs(File.Attributes)
End Select
Next filFile
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, Sh, True
Next fdrSubFolder
End If
GetFiles = True
GetFiles_End:
Exit Function
End Function
'---------------------------------------------
Function Attributs(Attrib)
Dim Res$
If Attrib = 0 Then Res = "Aucun attribut"
If Attrib And 1 Then Res = Res & "/Lecture seule"
If Attrib And 2 Then Res = Res & "/Caché"
If Attrib And 4 Then Res = Res & "/Système"
If Attrib And 32 Then Res = Res & "/Archive"
Attributs = Res
End Function
'---------------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Sélectionner le répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du répertoire.
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
'Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossier = Chemin
End Function
'---------------------------------------------
> Enfin quelque chose de simple! C'est vrai qu'en ligne commande, c'était un
peu difficile pour Serge ;-)
Bonjour à tous
Enfin quelque chose de simple! C'est vrai qu'en ligne commande, c'était un
peu difficile pour Serge ;-)
Rien que pour saisir ton code, Denis, je dois rajouter une barrette de
RAM ;-)
Bonne journée à vous 2.
Amicalement
J@@
MichDenis a écrit :
Et pour faire simple, il y a aussi ceci :
Différents bouts de code réunis dont un bout
de code publié sur le site de Frédéric Sigonneau.
'Variable dans le haut du module
Dim I As Integer
'-------------------------------------------------------
Sub TestGetFiles()
Dim Sh As Worksheet
Dim varItem As Variant
Dim strDirPath As String
Dim Répertoire_Par_Défaut As String
Répertoire_Par_Défaut = "C:UsersDM" 'à définir
If Dir(Répertoire_Par_Défaut) = "" Then
MsgBox "Chemin inexistant. Opération annulée."
Exit Sub
End If
I = 1
strDirPath = ChoixDossier(Répertoire_Par_Défaut)
Application.ScreenUpdating = False
Set Sh = Sheets.Add
If GetFiles(strDirPath, Sh, True) Then
EnTetes = Array("Chemin", "Nom", _
"Date création", "Date dernière modification", _
"Date dernier accès", "Taille", "Type",
"Attribut(s)")
With Sh.Range("A1:H1")
.Value = EnTetes
.Font.Bold = True
.Interior.ColorIndex = 43
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End If
With Sh
With .Range("A1:H1")
.EntireColumn.AutoFit
End With
With .Range("A1:H" & .Range("A65536").End(xlUp).Row)
.Sort key1:=Sh.Range("A2"), order1:=xlAscending, Header:=xlYes
End With
End With
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------
Function GetFiles(strPath As String, _
Sh As Worksheet, _
Optional blnRecursive As Boolean) As Boolean
Dim fsoSysObj As Object
Dim fdrFolder As Object
Dim fdrSubFolder As Object
Dim filFile As Object
If strPath = "C:UsersDMDocumentstest" Then Stop
Set fsoSysObj = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
GetFiles = False
GoTo GetFiles_End
End If
Err.Clear
For Each filFile In fdrFolder.Files
Select Case LCase(Split(filFile, ".")(1))
Case Is = "xls", "xlt", "xlb", "xlm", "xlsx", "xlxm", "xltx",
"xlsb"
I = I + 1
With filFile
ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated,
_
.DateLastModified, .DateLastAccessed, .Size, .Type)
End With
Sh.Cells(I, 1). _
Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
Sh.Cells(I, UBound(ArrFSO) + 2).Value =
Attributs(File.Attributes)
End Select
Next filFile
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, Sh, True
Next fdrSubFolder
End If
GetFiles = True
GetFiles_End:
Exit Function
End Function
'---------------------------------------------
Function Attributs(Attrib)
Dim Res$
If Attrib = 0 Then Res = "Aucun attribut"
If Attrib And 1 Then Res = Res & "/Lecture seule"
If Attrib And 2 Then Res = Res & "/Caché"
If Attrib And 4 Then Res = Res & "/Système"
If Attrib And 32 Then Res = Res & "/Archive"
Attributs = Res
End Function
'---------------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Sélectionner le répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du répertoire.
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
'Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossier = Chemin
End Function
'---------------------------------------------
> Enfin quelque chose de simple! C'est vrai qu'en ligne commande, c'était un
peu difficile pour Serge ;-)
Bonjour à tous
Enfin quelque chose de simple! C'est vrai qu'en ligne commande, c'était un
peu difficile pour Serge ;-)
Rien que pour saisir ton code, Denis, je dois rajouter une barrette de
RAM ;-)
Bonne journée à vous 2.
Amicalement
J@@
MichDenis a écrit :Et pour faire simple, il y a aussi ceci :
Différents bouts de code réunis dont un bout
de code publié sur le site de Frédéric Sigonneau.
'Variable dans le haut du module
Dim I As Integer
'-------------------------------------------------------
Sub TestGetFiles()
Dim Sh As Worksheet
Dim varItem As Variant
Dim strDirPath As String
Dim Répertoire_Par_Défaut As String
Répertoire_Par_Défaut = "C:UsersDM" 'à définir
If Dir(Répertoire_Par_Défaut) = "" Then
MsgBox "Chemin inexistant. Opération annulée."
Exit Sub
End If
I = 1
strDirPath = ChoixDossier(Répertoire_Par_Défaut)
Application.ScreenUpdating = False
Set Sh = Sheets.Add
If GetFiles(strDirPath, Sh, True) Then
EnTetes = Array("Chemin", "Nom", _
"Date création", "Date dernière modification", _
"Date dernier accès", "Taille", "Type",
"Attribut(s)")
With Sh.Range("A1:H1")
.Value = EnTetes
.Font.Bold = True
.Interior.ColorIndex = 43
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End If
With Sh
With .Range("A1:H1")
.EntireColumn.AutoFit
End With
With .Range("A1:H" & .Range("A65536").End(xlUp).Row)
.Sort key1:=Sh.Range("A2"), order1:=xlAscending, Header:=xlYes
End With
End With
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------
Function GetFiles(strPath As String, _
Sh As Worksheet, _
Optional blnRecursive As Boolean) As Boolean
Dim fsoSysObj As Object
Dim fdrFolder As Object
Dim fdrSubFolder As Object
Dim filFile As Object
If strPath = "C:UsersDMDocumentstest" Then Stop
Set fsoSysObj = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
GetFiles = False
GoTo GetFiles_End
End If
Err.Clear
For Each filFile In fdrFolder.Files
Select Case LCase(Split(filFile, ".")(1))
Case Is = "xls", "xlt", "xlb", "xlm", "xlsx", "xlxm", "xltx",
"xlsb"
I = I + 1
With filFile
ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated,
_
.DateLastModified, .DateLastAccessed, .Size, .Type)
End With
Sh.Cells(I, 1). _
Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
Sh.Cells(I, UBound(ArrFSO) + 2).Value =
Attributs(File.Attributes)
End Select
Next filFile
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, Sh, True
Next fdrSubFolder
End If
GetFiles = True
GetFiles_End:
Exit Function
End Function
'---------------------------------------------
Function Attributs(Attrib)
Dim Res$
If Attrib = 0 Then Res = "Aucun attribut"
If Attrib And 1 Then Res = Res & "/Lecture seule"
If Attrib And 2 Then Res = Res & "/Caché"
If Attrib And 4 Then Res = Res & "/Système"
If Attrib And 32 Then Res = Res & "/Archive"
Attributs = Res
End Function
'---------------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Sélectionner le répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du répertoire.
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
'Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossier = Chemin
End Function
'---------------------------------------------
n'oublie pas de passer par Québec; je serai aux
premières loges !
n'oublie pas de passer par Québec; je serai aux
premières loges !
n'oublie pas de passer par Québec; je serai aux
premières loges !