IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBScript Discussion :

VBScript mieux que VBa pour lister un ensemble de fichiers et de ses caractéristiques ?


Sujet :

VBScript

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éprouvé

    Profil pro
    MOA
    Inscrit en
    Décembre 2002
    Messages
    1 222
    Détails du profil
    Informations personnelles :
    Localisation : France, Eure et Loir (Centre)

    Informations professionnelles :
    Activité : MOA

    Informations forums :
    Inscription : Décembre 2002
    Messages : 1 222
    Par défaut VBScript mieux que VBa pour lister un ensemble de fichiers et de ses caractéristiques ?
    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

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 420
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 420
    Par défaut
    Peut-être un peu ce genre de code , mais à adapter !
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  3. #3
    Membre éprouvé

    Profil pro
    MOA
    Inscrit en
    Décembre 2002
    Messages
    1 222
    Détails du profil
    Informations personnelles :
    Localisation : France, Eure et Loir (Centre)

    Informations professionnelles :
    Activité : MOA

    Informations forums :
    Inscription : Décembre 2002
    Messages : 1 222
    Par défaut
    Tu m'excusera, la longueur du code de Browser4Folder m'a un peu découragé. Du coup, je suis allé faire des recherches et je suis tombé sur ce post : ici

    Je l'ai adapté pour avoir écrire dans un fichier txt et avoir la liste des fichier au lieu des répertoires.


    J'ai pas mal avancé
    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
     
     
    Option Explicit
     
    'Const outFile = "file.html"
    Const outFile = "toto.txt"
     
    Dim oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright
    Dim intSize,objShell,fso,strSize
    Copyright = "© Hackoo © 2013"
     
    MsgTitre = "Générer une arborescence d'un dossier en HTML "&Copyright&""
    Set objShell = CreateObject("Shell.Application")
    'Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
    'If objFolder Is Nothing Then WScript.Quit
     
    'CheminDossier = objFolder.self.path
    CheminDossier = "C:\Users\winSevenEn\Documents\test_list"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(CheminDossier)
    intSize = Dossier.Size
    If intSize = 0 Then
    	MsgBox "Le Dossier " & CheminDossier & " est vide",16,"Dossier Vide"
    	WScript.Quit
    End if
    MsgBox "Le Dossier " & CheminDossier & " est vide",16,"Dossier Vide"
     
    intSize = Round(FormatNumber(intSize)/(1024),2)
    If intSize < 1024 Then 
    	strSize = intSize & " Ko"
    elseif intSize < 1048576 Then 
    	strSize = Round(FormatNumber(intSize)/(1024),2)& " Mo"
    else
    	strSize = Round(FormatNumber(intSize)/(1073741824),2) & " Go"
    end If
     
    Set oFiletxt = fso.CreateTextFile(outFile,True)
    Set Ws = CreateObject("Wscript.Shell")
     
     
    StartTime = Timer 'Début du Compteur Timer
    'oFiletxt.WriteLine "+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & _
    	'CheminDossier & "'>" & CheminDossier & "</a><font color=""Yellow"">&nbsp;&nbsp;["&strSize&"]</font><br><br>" & _
    	'List(CheminDossier, CheminDossier) '& "</body></hmtl>"
    	List(CheminDossier)
    oFiletxt.Close
     
    DurationTime = FormatNumber(Timer - StartTime, 0) & " secondes." 'La durée de l'exécution du script
    Ws.Popup "La génération au format HTML est terminée en "& DurationTime & " !","5",MsgTitre,64
    Ws.Run outFile
     
     Function List(directory)
    'Function List(directory, directoryInputUser)
    	Dim objFso,objRootFolder,subfolders,objFile,objFolder,subfiles,NBFiles,intSize
    	On Error Resume next
    	Set objFso = CreateObject("Scripting.FileSystemObject")
    	Set objRootFolder = objFso.GetFolder(directory)
    	Set subfolders = objRootFolder.SubFolders
    	Set subfiles = objRootFolder.Files
     
    	NBFiles = 0
    	For each objFile in subfiles
    		NBFiles = NBFiles + 1
    		intSize = Round(FormatNumber(objFile.Size)/(1024),2)
     
    		oFiletxt.WriteLine(Mid(objFile.Path, Len("C:\Users\winSevenEn\Documents\test_list")+2) & ";" & objFile.Name & ";" & intSize)
    		'oFiletxt.WriteLine(objFile.Name)
    	Next
     
    	For each objFolder in subfolders		
    		List objFolder 'Appel récusive de la fonction List
    		'List objFolder, directoryInputUser 'Appel récusive de la fonction List
    		'oFiletxt.WriteLine("</DL>")
    	Next    
    End Function
    Il me restera :
    - à parser mes fichiers pour récupérer la date dans le nom
    - calculer le temps entre chaque fichier

    chose que je ne comprends pas, c'est que je n'arrive pas à faire passer 2 arguments. J'ai le message d'erreur m'indiquant que je n'ai pas le droit d'invoquer la procédure avec des parenthèses.

    Quand une procédure est déclaré avec un seul paramètre, elle peut être appeller avec des parenthèse comme tout language ( exemple toto(param) )
    Quand une procédure est déclaré avec deux paramètre (au moins, j'ai pas testé plus), elle NE peut PAS être appeller avec des parenthèse comme tout language ( exemple toto(param, param2) )
    Bon sinon je suis content, j'ai pas mal avancé, je pense que ce sera beaucoup plus efficace que via VBA.

  4. #4
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 420
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 420
    Par défaut
    Si la date recherchée est celle de la création, de modification ou du dernier accès au fichier, il est possible de la trouver.
    Par contre, je n'ai pas bien compris ce que tu veux dire par "calculer le temps entre chaque fichier".

    J'ai modifié un peu le script (et que hackoofr ne m'en veuille pas, j'ai quand même laissé son Copyright) en introduisant une fonction de formatage de la taille des fichiers pour obtenir ce
    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
     
     ' Copyright = "© Hackoo © 2013"
    Option Explicit
     
    Const outFile = "toto.txt"
     
    Dim oFiletxt,Ws, objFolder,CheminDossier, Dossier, TotalSize, NBFiles
    Dim intSize,objShell,fso,strSize
    '======================
    Set ShApp = CreateObject("Shell.Application")
        Const BIF_RETURNONLYFSDIRS = 1
        Dim DialogTitle, Item, ShApp
        DialogTitle = "Sélection de dossier(s) : (Pas de : Bureau, Poste de Travail, Favoris réseau et/ou ses sous-éléments)"
        Set Item = ShApp.BrowseForFolder(0, DialogTitle, BIF_RETURNONLYFSDIRS, "")
        If Item Is Nothing Then WScript.Quit 0
        CheminDossier = Item.ParentFolder.ParseName(Item.Title).Path
    Set ShApp = Nothing
    '======================
    NBFiles = 0
     
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(CheminDossier)
    intSize = Dossier.Size
     
    If intSize = 0 Then
        MsgBox "Le Dossier " & CheminDossier & " est vide",16,"Dossier Vide"
        WScript.Quit
    End if
    TotalSize = FormatSize(intSize)
     
    Set oFiletxt = fso.CreateTextFile(outFile,True)
    Set Ws = CreateObject("Wscript.Shell")
    List CheminDossier
    oFiletxt.WriteLine vbNewLine & "Taille totale du dossier : " & TotalSize & " (dans " & NBFiles & " fichiers)"
    Ws.Run outFile
    '=========================
     Function List(directory)
        Const L = 45
        Dim objFso, objRootFolder, osubfolders, objFile, objFolder, subfiles, intSize
        'On Error Resume next  ' ### cette instruction masque toujours les erreurs, donc à EVITER tant que possible
        ' J'ai exprès mis la ligne précédente en commentaire pour voir s'il y a des erreurs pendant
        ' l'exécution et il y en a : Argument ou appel de procédure incorrect : 'String'.
        ' Elle se produit lorsque la longueur du chemin au fichier dépasse la valeur de L.
        Set objFso = CreateObject("Scripting.FileSystemObject")
        Set objRootFolder = objFso.GetFolder(directory)
        Set osubfolders = objRootFolder.SubFolders
        Set subfiles = objRootFolder.Files
     
     
        For each objFile in subfiles
            NBFiles = NBFiles + 1
            intSize = FormatSize(objFile.Size)
            ' Formatage du texte de sortie pour une meilleure lisibilité
            ' Ligne où se produit l'erreur. Pour l'éviter, on doit augmenter la valeur de la constante L plus haut
             oFiletxt.WriteLine objFile.Path & String(L - Len(objFile.Path), " ") & "  Taille : " & intSize & String(18 - Len(intSize), " ") & " Créé : " & objFile.DateCreated
        Next
     
        For each objFolder in osubfolders        
            List objFolder 
        Next    
    End Function
    '======================
    Function FormatSize(iSize)
       Dim Units, I
       Units = Array(" Bytes", " KB", " MB", " GB", " TB", " PB", " EB", " ZB", " YB")
       For I = 0 To 8
           If iSize > 1024 Then
               iSize = iSize / 1024
           Else
               Exit For
           End If
       Next
       ' 10 tient compte du séparateur décimal et des 2 chiffres après ce séparateur.
       FormatSize = Right("0000000000" & FormatNumber(iSize, 2) , 10) & Units(I)
    End Function
    En espérant qu'il sera à ton goût.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  5. #5
    Membre éprouvé

    Profil pro
    MOA
    Inscrit en
    Décembre 2002
    Messages
    1 222
    Détails du profil
    Informations personnelles :
    Localisation : France, Eure et Loir (Centre)

    Informations professionnelles :
    Activité : MOA

    Informations forums :
    Inscription : Décembre 2002
    Messages : 1 222
    Par défaut
    En fait, le but de ce petit script est d'avoir une vision globale de la volumétrie des fichiers recus dans chaque répertoires. J'ai de la chance, je n'ai pas vraiment de gros besoin un simple fichier CSV suffit pour le moment.
    Ce fichier CSV sera convertis en Excel pour y faire des tableaux croisées dynamiques. Je pourrais faire facilement des agrégats par jours, également par heures. Ainsi, on pourra y apprendre les pics d'activités, deviner les plages horaires, le nombre de fichiers. ... Cela permettra ainsi de pouvoir faire des prévisions pour compléter des documents. J'avais donc justement fais exprès de supprimer la conversion sur d'autres unité parce que ces données sont amenés à être retravaillés.

    Pour les écarts, enfin de compte, pour le moment ce n'est pas très pertinent et il ne faut pas trop que je perde de temps la dessus. Je verrais cela un peu plus tard quand j'aurais le temps en tache de fond.

    Sinon pour info, les images valent mieux qu'un long discours comme on dit. Voila, ce que j'obtenais lorsque je lançais ma macro VBA :
    Nom : Capture.PNG
Affichages : 822
Taille : 35,9 Ko

    L'écart journalier correspond à la date du précédant fichier - la date du fichier courant par jour. Comme les fichiers sont recu sur des plages, il est inutile de calculer l'écart entre le dernier fichier de la veille et le premier fichier du jour (fichier courant). Dans ce cas précis, en G11 par exemple, j'avais mis à vide.

    Souvent en entreprises, les fichiers sont horodatés qui correspond à une date beaucoup plus fiable que la date système, il faudra donc je la parse.

    Voilou pour les infos.
    Je vais me repencher sur le sujet un peu plus tard.

  6. #6
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 420
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 420
    Par défaut
    Pour rechercher la date et l'heure à partir du nom du fichier, j'ai ajouté une fonction qui le fait.
    Le script retouché ressemblerait à ceci :
    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
      ' Copyright = "© Hackoo © 2013"
    Option Explicit
     
    Const outFile = "toto.txt"
     
    Dim oFiletxt,Ws, objFolder,CheminDossier, Dossier,  NBFiles
    Dim intSize,objShell,fso,strSize
    '======================
    Set ShApp = CreateObject("Shell.Application")
        Const BIF_RETURNONLYFSDIRS = 1
        Dim DialogTitle, Item, ShApp
        DialogTitle = "Sélection de dossier(s) : (Pas de : Bureau, Poste de Travail, Favoris réseau et/ou ses sous-éléments)"
        Set Item = ShApp.BrowseForFolder(0, DialogTitle, BIF_RETURNONLYFSDIRS, "")
        If Item Is Nothing Then WScript.Quit 0
        CheminDossier = Item.ParentFolder.ParseName(Item.Title).Path
    Set ShApp = Nothing
    '======================
    NBFiles = 0
     
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(CheminDossier)
    intSize = Dossier.Size
     
    If intSize = 0 Then
        MsgBox "Le Dossier " & CheminDossier & " est vide",16,"Dossier Vide"
        WScript.Quit
    End if
    'TotalSize = FormatSize(intSize)
     
    Set oFiletxt = fso.CreateTextFile(outFile,True)
    Set Ws = CreateObject("Wscript.Shell")
    List CheminDossier
     
    Ws.Run outFile
    '=========================
     Function List(directory)
     
        Dim objFso, objRootFolder, osubfolders, objFile, objFolder, subfiles, intSize
        'On Error Resume next  
        Set objFso = CreateObject("Scripting.FileSystemObject")
        Set objRootFolder = objFso.GetFolder(directory)
        Set osubfolders = objRootFolder.SubFolders
        Set subfiles = objRootFolder.Files
     
        For each objFile in subfiles
            If LCase(objFso.GetExtensionName(objFile.Name)) = "xml" Then
            NBFiles = NBFiles + 1
            intSize = FormatSize(objFile.Size)
             oFiletxt.WriteLine objFile.Path &  "    Taille : " & intSize  & "   Date : " & GetDateTimeFromFileName(objFile.Name)
            End If
        Next
     
        For each objFolder in osubfolders        
            List objFolder 
        Next    
    End Function
    '======================
    Function FormatSize(iSize)
       Dim Units, I
       Units = Array(" Bytes", " KB", " MB", " GB", " TB", " PB", " EB", " ZB", " YB")
       For I = 0 To 8
           If iSize > 1024 Then
               iSize = iSize / 1024
           Else
               Exit For
           End If
       Next
       ' 10 tient compte du séparateur décimal et des 2 chiffres après ce séparateur.
       FormatSize = Right("0000000000" & FormatNumber(iSize, 2) , 10) & Units(I)
    End Function
    '===================
    Function GetDateTimeFromFileName(sFileName)
        Dim Jour, mois, annee, hr, mn, sec, MaDate
     
        MaDate = Split(sFileName, "_")(3) ' 3 est la position de la date dans le nom du fichier; la première position étant zéro
        Jour = Mid(Madate, 9, 2)
        Mois = Mid(MaDate, 6, 2)
        Annee = Left(MaDate, 4)
        hr = Mid(MaDate, 12, 2)
        mn = Mid(MaDate, 14 ,2)
        sec = Right(MaDate,2)
        GetDateTimeFromFileName = Jour  & "/" & Mois & "/" & annee & " " & hr & ":" & mn & ":" & sec
    End Function
    A toi d'en juger et de modifier selon ton besoin
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  7. #7
    Expert éminent
    Avatar de Marc-L
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Avril 2013
    Messages
    9 468
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2013
    Messages : 9 468
    Par défaut
    Bonjour !

    Citation Envoyé par weed Voir le message
    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.
    Sachant que sans cache la fonction Dir VBA peut s'avérer être deux fois plus rapide que FSO
    et si c'est dans le cache le facteur peut monter à sept en faveur de Dir ! …

    Un scan complet de la partition système *.dl* sans cache et fichier d'échange vidé prend par exemple de mon côté
    avec Dir VBA 157 secondes (i5 2.5GHz disque dur non SSD) et avec cache 35 secondes,
    affichage dans Excel compris de plus de 42 200 fichiers …
    Pas de souci non plus en affichant tous les fichiers de la partition …     Et via les API Windows c'est encore plus rapide !

    Voir les exemples dans les sous-forums Contribuez et VBA du forum Excel ainsi dans les téléchargements le classeur de kiki29 (API) …

    S'il y a plantage, le code est donc en question (certainement un oubli de gestion d'erreur des cas particuliers) :
    il serait judicieux de connaître l'erreur affichée ainsi que la ligne de code la déclenchant
    le tout accompagné du code utilisé, pas ici mais dans le sous-forum VBA d'Excel bien entendu …

    _________________________________________________________________________________________________________
    Je suis Paris, Berlin, Nice, Bruxelles, Charlie, …

Discussions similaires

  1. [Batch] Script pour renommer un ensemble de fichiers.
    Par SiKhounet dans le forum Scripts/Batch
    Réponses: 6
    Dernier message: 01/05/2014, 16h50
  2. Microsoft fait mieux que prévu pour son second trimestre fiscal
    Par Stéphane le calme dans le forum Actualités
    Réponses: 41
    Dernier message: 31/01/2014, 16h34
  3. Réponses: 0
    Dernier message: 03/02/2011, 12h15
  4. aide pour lister les TCD du fichier
    Par chordially dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 05/07/2009, 09h41

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo