Hello tout le monde,

Je me suis fais une petite macro VBA qui a pour fonction de lister l'ensemble des fichiers d'un répertoire donné dans une feuille Excel avec les info suivantes :
- le nom du fichier
- sa taille
- la date (extraite du nom du fichier par des regex)
- la date et heure (extraite du nom du fichier par des regex)
- les écarts entre 2 fichiers en minute et secondes sur une journée

Le script en VBA fonctionne bien si les répertoires ne sont pas trop chargé en fichiers. Je suis limite obligé de lancer mon script le soir pour laisser tourner tranquillement Excel, sinon il se met à rapidement planter.


Je pensais donc peut être qu'en lancant un fichier *.vbs dans une console et qui écrirait dans un fichier Excel fermé serait peut être mieux. Je pourrais faire d'autres chose sur mon poste.
Est ce qu'il s'agit d'une solution interessante VBS dans ce cas de figure. Je me débrouille un peu en VBA, mais VBs pas du tout. Je pensais que c'était quasiment la même chose mais je viens de voir qu'il y a des commandes un peu différente. Un petit temps d'apprentissage sera nécessaire, il ne suffira pas de faire un copié collé de mon code VBA dans un fichier VBS et roulez ...




Pour info mon script

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As Boolean, lgRepParent As Integer)
  ' adapté de Ole P Erlandsen
  ' necessite d'activer la reference Microsoft Scripting RunTime
  ' dans lediteur : menu Outils => Reference pour activer
  Static FSO As FileSystemObject
  Dim oSourceFolder As Scripting.Folder
  Dim oSubFolder As Scripting.Folder
  Dim oFile As Scripting.File
  Dim annee As Integer, mois As Integer, jour As Integer, heure As Integer, minute As Integer
  Static wksDest As Worksheet
  Static iRow As Long
  Dim dateTime As Date, dateTimePrev As Date, parentFolderPrev As String
 
  annee = mois = jour = heure = minute = 0
  dateTimePrev = 0
  parentFolderPrev = ""
 
  Columns("D:D").NumberFormat = "dd/mm/yyyy"
  Columns("E:E").NumberFormat = "dd/mm/yyyy hh:mm"
  Columns("F:F").NumberFormat = "hh:mm"
 
  'bNotFirstTime = False
  'Debug.Print strFolderName
 
  If Not bNotFirstTime Then
    Set wksDest = ActiveSheet ' A adtapter
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With wksDest
      '.Cells(1, 1) = "Parent folder"
      .Cells(1, 1) = "Répertoire"
      .Cells(1, 2) = "Fichier"
      .Cells(1, 3) = "Taille en ko"
      .Cells(1, 4) = "Date"
      .Cells(1, 5) = "Date et heure"
      .Cells(1, 6) = "Ecart dans une journee"
    End With
    iRow = 2
    bNotFirstTime = True
  End If
  Set oSourceFolder = FSO.GetFolder(strFolderName)
  For Each oFile In oSourceFolder.Files
    'Debug.Print "iRow=" & iRow & "oFile.ParentFolder.Path " & oFile.ParentFolder.Path
    If InStr(oFile.Name, "xml") Then
 
        'parsing du nom du fichier pour recuper la date
        parseDate oFile.Name, annee, mois, jour, heure, minute
        dateStr = annee & "/" & mois & "/" & jour
        dateTime = DateSerial(annee, mois, jour)
        dateTime = DateAdd("h", heure, dateTime)
        dateTime = DateAdd("n", minute, dateTime)        
 
        If parentFolderPrev = oFile.ParentFolder.Path Then
            If Day(dateTimePrev) = Day(dateTime) And DateDiff("d", dateTimePrev, dateTime) <= 1 Then
                dateTimeDiffMin = DateDiff("n", dateTimePrev, dateTime)
                dateTimeDiffHeure = Int(dateTimeDiffMin / 60)
                dateTimeDiffMin = dateTimeDiffMin Mod 60
                dateTimeDiff = TimeSerial(dateTimeDiffHeure, dateTimeDiffMin, 0) 'le calcul doit se faire ici, car variable multi type
            Else
                dateTimeDiffMin = ""
                dateTimeDiffHeure = ""
                dateTimeDiff = ""
            End If
        Else
            dateTimeDiffMin = ""
            dateTimeDiffHeure = ""
            dateTimeDiff = ""
        End If
 
        Debug.Print "lg = " & Len(strFolderName) & " parent : " & oFile.ParentFolder.Path & ", mid : " & Mid(oFile.ParentFolder.Path, Len(strFolderName))
        With wksDest
          .Cells(iRow, 1) = Mid(oFile.ParentFolder.Path, lgRepParent + 1)          
          .Cells(iRow, 2) = oFile.Name
          .Cells(iRow, 3) = Round(oFile.Size / 1024, 0) ', "### ### ##0") 'conversion en ko
          .Cells(iRow, 4) = DateSerial(annee, mois, jour)
          .Cells(iRow, 5) = dateTime
          .Cells(iRow, 6) = dateTimeDiff
          '.Cells(iRow, 6) = oFile.DateCreated
          '.Cells(iRow, 7) = oFile.DateLastModified
          '.Cells(iRow, 8) = oFile.DateLastAccessed
        End With
    iRow = iRow + 1
    dateTimePrev = dateTime
    parentFolderPrev = oFile.ParentFolder.Path
 
    End If
  Next oFile
 
 
  'For Each oSubFolder In oSourceFolder.SubFolders
    ' On peut mettre ici un traitement spécifique pour les dossiers
  'Next oSubFolder
 
  If bIncludeSubfolders Then
    For Each oSubFolder In oSourceFolder.SubFolders
        ListFilesInFolder oSubFolder.Path, True, lgRepParent
    Next oSubFolder
  End If
  'Range("A:A").EntireColumn.Hidden = True
 
End Sub