Date de création SubFolder

Le 09/02/2021 à 10:47

Bonjour,

J'ai besoin de lister tous les sous dossier d'un dossier et de sortir leurs date de création. Pour le moment j'arrive à les lister mais impossible de sortir leurs date de création. J'ai essayer en créant un fl.DateCreated, mais cela ne fonctionne pas..

Code :

a = "CHEMIN"

If a = "" Then
Exit Sub
End If

    Dim fs, f, f1, s, sf
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(a)
    Set sf = f.SubFolders

    For Each f1 In sf

        s = Mid(f1.Name, 3, 30)
        c = Left(f1.Name, 3)
        Sheets("Sheet1").Select
        Cells(3 + i, 3).Select
        ActiveCell.FormulaR1C1 = s
        Cells(3 + i, 1).Select
        ActiveCell.FormulaR1C1 = c

    i = i + 1
    Next

Exit Sub

End Sub

Cela doit être sûrement très simple pour vous mais je débute !

Merci d'avance.

Le 09/02/2021 à 11:00

Bonjour toutes et tous

@ voir pour la variable f

date de création :

f.DateCreated

date de dernière modification :

f.DateLastModified

dernier accès :

f.DateLastAccessed

crdlt,

André

Le 09/02/2021 à 11:04

Bonjour Andre13,

Malheureusement j'ai déjà essayé, sauf qu'il me boucle sur les date du dossier parent donc toujours les mêmes.

Le 09/02/2021 à 11:21

Re,

peut être ici, avec Jacques Boisgontier merci à lui

http://boisgontierjacques.free.fr/pages_site/GestionRepertoire.htm

Le 10/02/2021 à 14:13

Toujours pas, là c'est pour lister les sous-dossiers que j'ai déjà.. Le soucis c'est pour sortir leurs date de création..

Le 10/02/2021 à 14:39

Bonjour toutes et tous

@Rayman025

merci du retour,

j'ai essayé avec ceci et cela me liste le répertoire avec la date de création MAIS pas pour les sous-dossiers à placer dans la feuill1 + donner juste le nom du dossier à lister, j'ai mis calculate manual est actif à la fin, j'ai regardé sur ce forum ou Eriiic (merci à lui) https://forum.excel-pratique.com/excel/application-screen-updating-t52100.html

après, je ne vois plus, peut-être qu'il manque un truc! mais quoi, je ne voit pas sniff

ci-dessous le code:

Option Explicit
Dim i As Integer
' source : https://stackoverflow.com/questions/35205588/adding-file-date-created-to-list
' https://www.excel-pratique.com/fr/vba/boites_de_dialogue
' https://forum.excel-pratique.com/excel/date-de-creation-subfolder-152830

Sub startIt()
On Error Resume Next
   Dim FileSystem As Object
   Dim HostFolder As String
  Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

  '
    HostFolder = InputBox("C:\Users\", "Nom du dossier à lister") 'La variable reçoit la valeur entrée dans l'InputBox

    If HostFolder <> "" Then 'Si la valeur est différente de "" on affiche le résultat
   '     MsgBox HostFolder

HostFolder = HostFolder

   Set FileSystem = CreateObject("Scripting.FileSystemObject")
   DoFolder FileSystem.GetFolder(HostFolder)
Application.Calculation = xlCalculationAutomatic

Else: Exit Sub

    End If
 End Sub

 Sub DoFolder(Folder)
On Error Resume Next
 Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
      DoFolder SubFolder
    Next

    i = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Dim File
    For Each File In Folder.Files
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:= _
          File.Path, TextToDisplay:=File.Path
      Cells(i, 2).Value = File.DateCreated

      i = i + 1

    Next
Application.Calculation = xlCalculationAutomatic
End Sub
10sousdossier-test001.xlsm (24.17 Ko)

crdlt,

André

Le 11/02/2021 à 01:42

Bonjour Rayman, Salut Andre ,

Voici un essai car j'ai l'impression que .datecreated a été d'abord oublié puis a porté sur la mauvaise variable :

sub pourcouleurs()

Dim fs, f, f1, s, sf

a = "CHEMIN"
If dir(a, vbdirectory) = "" Then Exit Sub

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(a)
Set sf = f.SubFolders

with Sheets("Sheet1")
    For Each f1 In sf
        .Cells(3 + i, 3).value = Mid(f1.Name, 3, 30)
        .Cells(3 + i, 1).value = Left(f1.Name, 3)
        .cells(3 + i, 4).value = f1.datecreated
        i = i + 1
    Next
end with

End Sub

Cdlt,

Le 11/02/2021 à 07:39

Bonjour, si ça peut aider, j'ai mis en remarque les fichiers trouvés et leur date en plus des dossiers.

Option Explicit

Public fMem As String

Sub RecursiveFiles()
    Dim f As Object, fso As Object, flder As Object
    Dim folder As String
    Dim wb As Workbook, ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    Set fso = CreateObject("Scripting.FileSystemObject")

    Cells(1, 1) = "Folder"
    Cells(1, 2) = "Date"
    fMem = "***"

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Cancel Selected"
            End
        End If
        folder = .SelectedItems(1)
    End With

    ListIndividualFiles ws, fso, folder
    Columns("A:A").Columns.AutoFit
End Sub

Private Sub ListIndividualFiles(ws, fso, folder)
    Dim extn, f, fo, datfic

    For Each f In fso.GetFolder(folder).Files
        If folder <> fMem Then
            ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) = folder
            fMem = folder
            datfic = FileDateTime(folder & "\" & f.Name)
            ws.Range("B" & ws.Rows.Count).End(xlUp).Offset(1, 0) = datfic
            'ws.Range("C" & ws.Rows.Count).End(xlUp).Offset(1, 0) = f.Name
            'extn = Split(f.Name, ".")
            'If (UBound(extn) > 0) Then extn = extn(UBound(extn))
            'ws.Range("D" & ws.Rows.Count).End(xlUp).Offset(1, 0) = extn
        End If
    Next 'f

    For Each fo In fso.GetFolder(folder).subFolders
        ListIndividualFiles ws, fso, folder & "\" & fo.Name
    Next 'fo
End Sub
Le 11/02/2021 à 08:07

Bonjour toutes et tous

mercis à vous : 3Gb et Optimix

je vais regarder cela tout à l'heure, merci en tout cas

Le 11/02/2021 à 09:47

Re,

J'ai testé vos 2 classeurs et cela fonctionne bravissimo !

  • celui de 3 Gb , j'ai juste à déclarer les 2 variables si l'Option Explicit à l' en-tête du code, le code je l'ai placé dans la feuille du classeur en question

" i " pour integer et "a" pour le CHEMIN, modifier le chemin bien entendu dans le code + ne pas oublier de modifier le nom de la feuille Sheet1

conclusion : fonctionnel ^^

  • celui d'Optimix , idem j'ai placé le code dans la feuille du classeur, il créé Folder + Date en entête de la feuille du classeur, il faudrait juste après qu'il puisse formaté les 2 colonnes A et B après pour que l'on puisse le renouveler mais cela n'affecte en rien

conclusion : fonctionnel ^^

merci @ vous deux

Le 11/02/2021 à 09:54

Salut Andre !

Grazie mille ! Merci d'avoir testé et pour ton implication !

Allez, une rien que pour toi : "Elu Mr Office, va Andre, perd NA, avec if formulé"

A plus,

Le 11/02/2021 à 09:57

Re,

Grazie 3GB, je kif grave vos codes, ils sont tellement bien codés pas comme moi et grâce à vous on en apprend

Le 11/02/2021 à 10:10
Merci André
    Une belle indentation
        ça en jette !
    :)
^^
Le 24/02/2021 à 08:54

Parfait ! Je vous remercie pour votre implication :)

Rechercher des sujets similaires à "date creation subfolder"