VBA fichier & Dossier Résolu

Question

Bonjour,

VBA n'étant pas du tout mon fort je fais appel au pro que vous êtes ;) car j'ai trouvé beaucoup de chose sur internet via Google mais rien que je sache modifier.

Je cherche à faire une liste de fichiers comprenant chemin + fichier dans la colonne A1 de la feuille courante.

Avec comme possibilités :
1. Sélectionner plusieurs fichiers de type *.log et les ajouter à la liste existante ( DIR *.log)
2. Sélectionner un dossier et donc afficher la liste des fichiers *.log y compris dans les sous répertoire (DIR *.log /S)  et les ajouter à la liste existante.

J'espère avoir été clair... 
Je vous remercie par avance

pijaku · Answer

Bonjour,

Essaye déjà cette macro, juste pour voir si qui ne te convient pas...

'sources
'http://www.excel-downloads.com/forum/126930-vba-liste-dossiers-et-sous-dossiers-dun-dosssier.html
Dim ligne
Sub arborescenceRepertoire()
  racine = ChoixDossier()     ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Range("A:E").ClearContents
  Range("A1:E60000").EntireRow.Hidden = False
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.GetFolder(racine)
  ligne = 3
  Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
  Dim oFile
  Dim CheminDuFichier As String
           Application.ScreenUpdating = False
   Cells(ligne, 2) = String(3 * (niveau - 1), " ") & dossier.Name
   Cells(ligne, 2).Font.Bold = True
   ligne = ligne + 1
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
          For Each oFile In d.Files
            Cells(ligne, 3).Value = oFile.Name
            CheminDuFichier = d & "\" & oFile.Name
             ActiveSheet.Hyperlinks.Add Anchor:=Cells(ligne, 3), Address:= _
        CheminDuFichier ', TextToDisplay:="bordereau DRH.doc"
            Cells(ligne, 3).EntireRow.Hidden = True
            ligne = ligne + 1
          Next oFile
   Next d
            Application.ScreenUpdating = True
      Columns(2).EntireColumn.AutoFit
End Sub

Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function

Bypass · Answer

Bonjour pijaku, et merci pour ta réponse.
Mais ces fonctions ressemble (sous dos) à command.com /c tree /F /A
Je pense m'être mal expliqué.
Ce que je cherche c'est plutôt le liste des fichiers .log dans un dossier et ses sous dossier. J'ai trouvé mDFScanFichiers sur le net (http://www.excel-downloads.com/forum/107839-extraire-le-detail-des-fichiers-dun-repertoire-windows-vers-excel-2.html) qui après quelques adaptations me correspond bien.

Maintenant je cherche à pouvoir ajouter un ou plusieurs fichiers à la liste déjà obtenu un truc de ce genre...

Sub Chemin1fichier()
Dim fd As Object, nom$
Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .Title = "Choisissez le Fichier"
        .InitialFileName = "*.log"
        .Filters.Clear
        .AllowMultiSelect = False
        If .Show <> 0 Then
            nom = .SelectedItems(1)
        Else
            MsgBox "Vous n'avez serlectionné aucun fichier", , "Recommencer"
        End If
    End With
Range("B1") = nom
End Sub

Ce code me conviendrais si je pouvais l'adapter et sélectionner plusieurs fichiers en même temps.

Merci à vous

pijaku · Answer

Bonjour, 

Ce code me conviendrais si je pouvais l'adapter et sélectionner plusieurs fichiers en même temps.  
Pas de souci! 
Sélectionner plusieurs fichiers en même temps : .AllowMultiSelect = True
Puis les stocker dans une variable tableau dynamique : 
        For Each varItems In .SelectedItems 
            ReDim Preserve nom(i) 
            nom(i) = varItems 
            i = i + 1 
        Next 

Les restituer, colonne B, en dessous des éléments déjà existants : 
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(nom) + 1, 1) = Application.Transpose(nom)
Ce qui nous donne : 
Sub Chemin1fichier() 
Dim fd As Object, nom(), varItems, i& 
Set fd = Application.FileDialog(msoFileDialogOpen) 
With fd 
    .Title = "Choisissez le(s) Fichier(s)" 
    .InitialFileName = "*.log" 
    .Filters.Clear 
    .AllowMultiSelect = True 
    If .Show <> 0 Then 
        For Each varItems In .SelectedItems 
            ReDim Preserve nom(i) 
            nom(i) = varItems 
            i = i + 1 
        Next 
    Else 
        MsgBox "Vous n'avez selectionné aucun fichier", , "Recommencer" 
        Exit Sub 
    End If 
End With 
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(nom) + 1, 1) = Application.Transpose(nom) 
End Sub  
  
Cordialement, 
Franck P

Bypass · Answer

Wooow! que dire.... It's perfecto!

Merci  pijaku, c'est une grosse épine qui vient de tomber :D

VBA fichier & Dossier

4 réponses

Discussions similaires

Newsletters