Ouvrir un répertoir et lister les fichier VBA Résolu

Question

Bonjour tous le monde!!!!

Je viens en quête de votre savoir une fois de plus!!!

Alors, j'aimerai savoir comment faire pour : 
- ouvrir un dossier, c'est-à-dire la fonction qui ouvre une fenêtre te demandant de sélectionner le dossier qu'il faut ouvrir
- puis lister tous les fichier .txt de ce dossier, une fois qu'il a été sélectionner

En fait j'aimerai qu'ils soient listés un par un, car je dois récupérer des informations à l'interieur de ces fichiers txt.

Voilà. une idée?

Merci beaucoup à tous!

Polux31 · Accepted Answer

Bonjour,

Il faut tout d'abord déclarer la référence : Microsoft Scripting Runtime.

Public Function chooseFolder() As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
chooseFolder = oFolderItem.Path


Cette fonction ouvre le browser et retourne le chemin du fichier sélectionner.

La suivante stocke dans un tableau passé en référence à la fonction tout les fichiers d'un répertoire passé en paramètre. On peut passer également une extension (optionale).

'*********************************************************************
' Fonction qui renvoie la liste de tous les fichier d'un répertoire
' Nécessite la référence Microsoft Scripting Runtime
'*********************************************************************

Public Function AllFilesInFolder(ByVal NomDossier As String, ByRef myTab, Optional ByVal ExtentionType As String) As Boolean
Dim fso As Object, dossier As Object, Fich As Object
Dim Files As Object, File As Object
Dim max As Long, ext As String

    'Initialisation du tableau
    ReDim myTab(0)
    '
    ' Création de l'objet FSO
    On Error Resume Next ' AllFilesInFolder_Error

    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Si le nom du dossier est vide, alors je sort de la fonction
    If NomDossier = "" Then Exit Function
    ' Stock les sous-répértoires dans l'objet dossier
    Set dossier = fso.GetFolder(NomDossier)
    
    ' stock dans l'objet Files tous les fichiers de l'objet dossier
    Set Files = dossier.Files
    ' s'il y a plus d'un fichier
    If Files.Count <> 0 Then
        max = 0
        ' pour tous les objets fichiers dans l'objet files
        For Each File In Files
          '
          ' je récupère le nom du fichier via l'objet Fich
          Set Fich = fso.GetFile(File)
          ' si l'extension n'est pas renseignée
          ext = ExtentionType
          If ExtentionType = "" Then ext = fso.GetExtensionName(File)
          '
          If UCase(fso.GetExtensionName(File)) = UCase(ext) Then
            max = max + 1
            ' j'augmente la taille de mon tableau résultat
            ReDim Preserve myTab(1 To max)
            ' Je stock en fin de tableau mon nom de fichier
            myTab(max) = File
          End If
        Next
        ' Je retourne le tableau complet des nom de fichiers
    End If
    '
    ' Libère tous les objets
    Set fso = Nothing
    Set dossier = Nothing
    Set Fich = Nothing
    Set Files = Nothing
    Set File = Nothing
    '
    
    If Err.Number = 0 Then
        AllFilesInFolder = True
        Exit Function
    Else
        AllFilesInFolder = False
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AllFilesInFolder"
    End If
End Function


;o)

2pax.cruz · Answer

Quel est largument MyTab?


Merci.

Ouvrir un répertoir et lister les fichier VBA

2 réponses

Votre réponse

Newsletters