Autres [XL 2007] VBA listage répertoire Nom fichier, Date, Taille

[kif]

Bonjour La Team

Avez vous SVP un exemple de code qui permets de lister un sous répertoire (fixe) de mon workbook, me permettant de recuperer à partir de la cellule C15 la liste des fichiers présents avec leur taille et date de création ?

... de mon workbook, le sous répertoire fixe sera toujours /2-Client/

Merci d'avance de votre support

Salutations

Franck

 

[patricktoulon]

ah!!!!!

Petite modif de ton code : sfilename = Dir(Rep & "\*.*") car c'est tout type de fichiers que je liste

en voilà une drole d'histoire hein !!!
j'etais parti sur la base de @ChTi160 qui ne listait que les fichiers excel
bon ben je suppose que tu a ta liste maintenant

 

[kif]

ce qui me donne une erreur "1004 "impossible de definir propriété NumberFormat de la classe Range"
sur l'instruction

.Cells(i, 3).NumberFormat = "#0.00" & IIf(.Cells(i, 3) < 1000, " KO", " MO")

Mais cela importe quand méme la liste :

(32062 Fwd FW PO 2124153.eml	16/12/2021 09:00:05	5885​
HW-03034EAAA-MSD-03-00.pdf	16/12/2021 09:00:08	1522.4​
HW-P3034EAAA-GERBER_01-00.zip	16/12/2021 09:00:11	131.17​
HW-P3034EAAA-ODBJOB_01-00.tgz	16/12/2021 09:00:14	598.37​
PO 2124153.PDF	16/12/2021 09:00:16	1977.5

 

[patricktoulon]

re
essaie
peut etre que tu a parametré le separateur decimal avec le point chez toi

.Cells(i, 3).NumberFormat = "#0,00" & IIf(.Cells(i, 3) < 1000, " KO", " MO")

 

[kif]

Oui c'est le point mais j'ai toujours une 1004

 

[patricktoulon]

vraiment bizarre ton truc hein
voilà ce que c'est de modifier des parametres crutiaux dans excel
on essaie CDbl au cas ou

Private Sub CommandButton1_Click()
    Dim T(), Rep$, sfilename$, dl&, n&
    Rep = ThisWorkbook.Path & "\2-Client"
    If Dir(Rep, vbDirectory) = "" Then MsgBox "Dossier inexistant", 16: Exit Sub
    sfilename = Dir(Rep & "\*.xls*")
    Do While sfilename <> ""
        n = n + 1: ReDim Preserve T(1 To 3, 1 To n)
        T(1, n) = sfilename
        T(2, n) = FileDateTime(Rep & "\" & sfilename)
        T(3, n) = CDbl(FileLen(Rep & "\" & sfilename) / 1000)
        sfilename = Dir
    Loop
    With Sheets("Index Docs").Range("C15")
        .CurrentRegion.ClearContents
        If n > 0 Then
            .Resize(n, 3) = Application.Transpose(T)
            For i = 1 To n
                .Resize(n, 3).Cells(i, 3).NumberFormat = "#0.00" & IIf(.Cells(i, 3) < 1000, " Ko", " Mo")
            Next
        End If
    End With
End Sub

 

[patricktoulon]

OUPSS!!!!! autant pour moi je suis dans un bloc with alors

.Resize(n, 3).Cells(i, 3).NumberFormat = "#0.00" & IIf(.resize(n,3).Cells(i, 3) < 1000, " Ko", " Mo")

je me suis levé du pied gauche ce matin

 

[kif]

Fonctionne mais toujours une 1004 NumberFormat dans la Classe Range

 

[patricktoulon]

A tu une fenêtre près de toi? A tu déjà vu un pc voler?

 

[kif]

J'ai deja le marteau à coté , et un verre d'eau

 

[kif]

Si je supprime la boucle for i avec le rezize ça fonctionne et j'ai plus l'erreur ?

 

[kif]

Bon voila ça ira bien comme cela, Merci beaucoup pour votre support

Bonnes fêtes à tous

Franck

 

[kif]

Mince désolé, merguez que je suis! j'ai oublier un truc important du coup

A partir de ce code est il possible de lister aussi les sous répertoire ?


Private Sub CommandButton1_Click()
Dim T(), Rep$, sfilename$, dl&, n&
Rep = ThisWorkbook.Path & "\2-Client"
If Dir(Rep, vbDirectory) = "" Then MsgBox "Dossier inexistant", 16: Exit Sub
sfilename = Dir(Rep & "\*.**")
Do While sfilename <> ""
n = n + 1: ReDim Preserve T(1 To 3, 1 To n)
T(1, n) = sfilename
T(2, n) = FileDateTime(Rep & "\" & sfilename)
T(3, n) = CDbl(FileLen(Rep & "\" & sfilename) / 1000)
sfilename = Dir
Loop
With Sheets("Index Docs").Range("C15")
.CurrentRegion.ClearContents
If n > 0 Then
.Resize(n, 3) = Application.Transpose(T)
'For i = 1 To n
'.Resize(n, 3).Cells(i, 3).NumberFormat = "#0.00" & IIf(.Cells(i, 3) < 1000, " Ko", " Mo")
'Next
End If
End With
End Sub

 

[ChTi160]

Re
est-ce que

sfilename = Dir(Rep & "\*.*")

et pareil que ça

sfilename = Dir(Rep & "\*.**")

Sans prétention ,aucune !
jean marie

 

[kif]

Bien vu faute de frappe



Private Sub CommandButton1_Click()
Dim T(), Rep$, sfilename$, dl&, n&
Rep = ThisWorkbook.Path & "\2-Client"
If Dir(Rep, vbDirectory) = "" Then MsgBox "Dossier inexistant", 16: Exit Sub
sfilename = Dir(Rep & "\*.*")
Do While sfilename <> ""
n = n + 1: ReDim Preserve T(1 To 3, 1 To n)
T(1, n) = sfilename
T(2, n) = FileDateTime(Rep & "\" & sfilename)
T(3, n) = CDbl(FileLen(Rep & "\" & sfilename) / 1000)
sfilename = Dir
Loop
With Sheets("Index Docs").Range("C15")
.CurrentRegion.ClearContents
If n > 0 Then
.Resize(n, 3) = Application.Transpose(T)
'For i = 1 To n
'.Resize(n, 3).Cells(i, 3).NumberFormat = "#0.00" & IIf(.Cells(i, 3) < 1000, " Ko", " Mo")
'Next
End If
End With
End Sub

 

[ChTi160]

Re
pourrais-tu être plus explicite !

Mince désolé, merguez que je suis! j'ai oublier un truc important du coup
A partir de ce code est il possible de lister aussi les sous répertoire ?

Fichier , Exemples , Explications
jean marie