Modif de macro lister Fichier

[Geraldine]

Bonjour, je n'arrive pas a modifier cette macro pour que la destination des infos soit en "feuil2".

Sub TheFileLister()
Dim TheFileSearcher As FileSearch
Dim i%, ThePath$, Z$
ThePath = "D:\DOSSIER\"
On Error Resume Next
Set TheFileSearcher = Application.FileSearch
With TheFileSearcher
.NewSearch
.Filename = "*.xls*"
.LookIn = ThePath
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For i = 1 To .Count
Z = Dir(.Item(i))
Sheets("Feuil2").Hyperlinks.Add Anchor:=Cells(i + 3, 2), Address:=ThePath & "\\" & Z, _
TextToDisplay:=Z
Next i
End With
Else
End If
End With
Set TheFileSearcher = Nothing
End Sub

Merci à vous, Géraldine

 

[Bebere]

Re : Modif de macro lister Fichier

bonjour Géraldine,le forum
tu changes .Filename = "*.xls*" en .Filename = "*.xls" et c'est ok
testé avec excel2000
à bientôt

 

[Geraldine]

Re : Modif de macro lister Fichier

Re, bebere

moi ça marche pas et de plus mon application vas devoir fonctionner sous excel 2007, donc des modifs à apporter ...

Merci quand meme.
Géraldine

 

[Geraldine]

Re : Modif de macro lister Fichier

Re, comme j'utilise des macros trouvées sur le forum, j'ai du mal à les adapter.

Mon problème, comme j'ai une userform en showmodal.false, il me faut specifier a mes deux macro, la destination soit le dossier [DONNEES] et la feuille "LISTE", parce que j'ai des bugs quand je suis dans un autre dossier et que j'execute les macros.

Mes deux macros :

Sub TheFileLister()
Dim TheFileSearcher As FileSearch
Dim i%, ThePath$, Z$
ThePath = "D:\DOSSIER\"
On Error Resume Next
Set TheFileSearcher = Application.FileSearch
With TheFileSearcher
.NewSearch
.Filename = "*.xls*"
.LookIn = ThePath
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For i = 1 To .Count
Z = Dir(.Item(i))
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 3, 2), Address:=ThePath & "\\" & Z, _
TextToDisplay:=Z
Next i
End With
Else
End If
End With
Set TheFileSearcher = Nothing
End Sub

et

Sub chercheFichiersFermesV03()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Application.ScreenUpdating = False
Direction = Dir("D:\DOSSIER\*.xls")
Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop
If nbFichiers > 0 Then
For X = 1 To nbFichiers
If Tableau(X) <> ThisWorkbook.Name Then
Y = Y + 1
With Sheets("LISTE").Cells(Y + 3, 3)
.Formula = "='D:\DOSSIER\[" & Tableau(X) & "]Feuil1" & "'!" & "h6"
.Value = .Value
End With
End If
Next X
End If
Application.ScreenUpdating = True
End Sub

Merci à tous, Géraldine

 

[bqtr]

Re : Modif de macro lister Fichier

Bonjour Geraldine, Bebere

juste un petit passage pour préciser que : Application.FileSearch
n'est plus supporté par excel 2007.

bonne journée

 

[Bebere]

Re : Modif de macro lister Fichier

bonjour Bqtr

Géraldine essaye ce code,tu choisis un dossier

Sub TousFichiersDunDossier()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer

Set fso = CreateObject("Scripting.FileSystemObject")
NomDossier = ChoisirDossier
If NomDossier = "" Then Exit Sub
Set Dossier = fso.getfolder(NomDossier)

Set Files = Dossier.Files
Sheets("Feuil2").Cells.Clear
If Files.Count <> 0 Then
With Sheets("Feuil2")
For Each File In Files
If Right(File.Name, 4) = ".xls" Then
i = i + 1
.Cells(i, 1).Value = File.Path
.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=File.Path
End If
Next File
End With
End If

Sheets("Feuil2").Columns("A").AutoFit

End Sub

Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:\Windows\Bureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function

à bientôt

 

[Geraldine]

Re : Modif de macro lister Fichier

merci bebere,

je vais mediter toute l'après midi sur ton code.
Bonne journée. géraldine