File Search pour excel 2007

J'utilisais File Search pour lister les fichiers contenus dans un répertoire. Cette fonction semble avoir disparu dans excel 2007. Comment faire ?

File Search ne fonctionne effectivement plus sous excel 2007. Tu peux utiliser une solution de contournement pour récupérer la liste des fichiers contenus dans un dossier

Public Function getDir(path As String, sortie As String) As Variant
 Dim fList() As String
 Dim iPosition As Long
 Dim iSize As Long
 Dim sFile As String
 Dim fRange As Excel.Range
 Const iIncrement As Long = 50
          
 iSize = iIncrement
 ReDim fList(1 To iSize)
 'vous pouvez indiquer *.* pour obtenir la liste de tous les fichiers ou filtrer par l'extension
 sFile = Dir(path & IIf(Right(path, 1) = "", "", "") & "*.xls")
          
 Do While Len(sFile)
 iPosition = iPosition + 1
 If iPosition > iSize Then
 iSize = iSize + iIncrement
 ReDim Preserve fList(1 To iSize)
 End If
 fList(iPosition) = sFile
 sFile = Dir
 Loop
          
 If iSize > iPosition Then
 ReDim Preserve fList(1 To iPosition)
 End If
          
 Set fRange = Range(sortie).Resize(iPosition, 1)
 fRange.Value = WorksheetFunction.Transpose(fList)
 fRange.Sort key1:=fRange.Cells(1), order1:=xlAscending
 getDir = fRange.Value
 
 End Function
  

pour utiliser cette fonction depuis une macro, en utilisant l'adresse du répertoire située en A1 et pour restituer la liste des fichiers dans en E1, E2 ...

Public Sub FileSearch2007()
 Dim v As Variant
 v = getDir(Feuil1.Cells(1, 1), "E1")
end sub

Si tu as besoin en plus de lister les sous répertoires utilise plutôt cette macro :

Public Ligne As Long

Sub RechercheFichiers()
   Ligne = 0
   racine = "e:\donnees\daniel\mpfe" 'Mets ici ton dossier pricipal
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set dossier_racine = fso.getfolder(racine)
   Lit_dossier dossier_racine
End Sub
Sub Lit_dossier(ByRef dossier)
  For Each d In dossier.SubFolders
    Lit_dossier d
  Next
  For Each f In dossier.Files
       Ligne = Ligne + 1
       ActiveSheet.Hyperlinks.Add Cells(Ligne, 1), f.Path, 
TextToDisplay:=f.Name
       'Cells(Ligne, 1) = f.Path
  Next
End Sub

Auteurs : , , ,

Mots clefs associés à cette page : , , , , , ,