Scan de répertoire

bonjour

journalliérement je sauvegarde des email dans un répertoire, au format MHT

je me demande s'il y a un moyen de créer un fichier excel qui....quand je l'ouvre scan le repertoire et me met dans un colone (exemple A) tous les noms des fichier 1 à 1

merci pour l'aide

Bonsoir,

D'abord La procédure nécessite d'activer la référence "Microsoft Scripting RunTime".

Dans l'éditeur de macros (Alt+F11):

Menu Outils

Références

Cliquez sur le bouton OK pour valider.

copier le code dans un module et l'affecter à un bouton

change le nécessaire chemin, extension

Option Explicit

Sub Lister_Fichiers()
    Dim Fichier As String, Chemin As String
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    '
    Dim Fso As Scripting.FileSystemObject
    Dim FileItem As Scripting.File
    Dim Tableau()
    Dim Plage As Range
    Dim m As Integer, i As Integer
    Dim z As Byte, Valeur As Byte
    Dim Cible As Variant

    '---liste les fichiers du répertoire ---
    Chemin = "D:\POI" 'à changer
    Fichier = Dir(Chemin & "\*.MHT") ' à changer selon le besoin

    'Boucle sur les fichiers
    Do

        m = m + 1
        ReDim Preserve Tableau(1 To 2, 1 To m)
        Tableau(1, m) = Fichier

        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier)

        'Récupère la date de création
        Tableau(2, m) = Left(FileItem.DateCreated, 10)
        'Pour récupérer la date de dernière modification
        'Tableau(2, m) = Left(FileItem.DateLastModified, 10)
        'Pour récupérer la taille du fichier
        'Tableau(2, m) = Left(FileItem.Size, 10)

        Fichier = Dir
    Loop Until Fichier = ""

    '---Trie les fichiers par ordre décroissant de création ---
    Do
        Valeur = 0
        For i = 1 To m - 1
            If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then
                For z = 1 To 2
                    Cible = Tableau(z, i)
                    Tableau(z, i) = Tableau(z, i + 1)
                    Tableau(z, i + 1) = Cible
                Next z

                Valeur = 1
            End If
        Next i
    Loop While Valeur = 1

    '--- Transfère les données dans la feuille de calcul ---
    Set Plage = Worksheets("Feuil1").Range("A1")
    Set Plage = Plage.Resize(UBound(Tableau(), 2), UBound(Tableau()))
    Plage = Application.Transpose(Tableau())

End Sub

Bonjour

yesssssssssssssss

ça fonctionne

merci

Rechercher des sujets similaires à "scan repertoire"