macro pour recherche automatique de chemin d'accès à un fichier

Le
AB
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent par F, et
comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un dossier
comportant plusieurs sous-dossiers. Les fichiers peuvent donc être dans un
sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C, le chemin
complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #5290721
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens si tu as
cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent par F,
et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un dossier
comportant plusieurs sous-dossiers. Les fichiers peuvent donc être dans un
sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C, le
chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB



AB
Le #5289911
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens si tu
as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent par F,
et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un dossier
comportant plusieurs sous-dossiers. Les fichiers peuvent donc être dans
un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C, le
chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB







Daniel.C
Le #5289511
Bonsoir.
En m'inspirant très largement d'un code de JB auquel il revient une très
grande partie du crédit, utilise le code suivant :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)
racine = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If c.Value & ".xls" = TabloF(i) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".xls" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Cordialement.
Daniel
"AB" %
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens si tu
as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent par
F, et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un
dossier comportant plusieurs sous-dossiers. Les fichiers peuvent donc
être dans un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C, le
chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB











Daniel.C
Le #5289371
Erratum.
Pour des fichiers htm, mettre :
If c.Value & ".htm" = TabloF(i) Then
au lieu de :
If c.Value & ".xls" = TabloF(i) Then
dans la macro Recherche.
Daniel
"Daniel.C"
Bonsoir.
En m'inspirant très largement d'un code de JB auquel il revient une très
grande partie du crédit, utilise le code suivant :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)
racine = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If c.Value & ".xls" = TabloF(i) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".xls" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Cordialement.
Daniel
"AB" %
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens si
tu as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent par
F, et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un
dossier comportant plusieurs sous-dossiers. Les fichiers peuvent donc
être dans un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C, le
chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB















AB
Le #5137221
Bonsoir Daniel,
J'ai essayé ton code.
Je l'ai placé dans un module.
Lorsque je lance la macro, j'ai le sablier pendant environ 30s, puis plus
rien, et rien n'a été modifié...
André

"Daniel.C" %
Erratum.
Pour des fichiers htm, mettre :
If c.Value & ".htm" = TabloF(i) Then
au lieu de :
If c.Value & ".xls" = TabloF(i) Then
dans la macro Recherche.
Daniel
"Daniel.C"
Bonsoir.
En m'inspirant très largement d'un code de JB auquel il revient une très
grande partie du crédit, utilise le code suivant :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)
racine = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If c.Value & ".xls" = TabloF(i) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".xls" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Cordialement.
Daniel
"AB" %
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens si
tu as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent par
F, et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un
dossier comportant plusieurs sous-dossiers. Les fichiers peuvent donc
être dans un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C, le
chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB



















Daniel.C
Le #5143621
Bonjour.
Toutes mes excuses, j'avais laissé traîner un ".xls" au lieu d'un ".htm".
J'ai rajouté une sécurité pour ignorer les différences majuscules /
miniscules. C'est normal que la macro soit un peu longue, elle scanne tous
les sous-dossiers du dossier maître :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
Dim fso As Scripting.FileSystemObject
ReDim TabloD(0)
ReDim TabloF(0)

racine = ThisWorkbook.Path
Set fso = New Scripting.FileSystemObject
'Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If UCase(c.Value & ".htm") = UCase(TabloF(i)) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".htm" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Daniel
"AB"
Bonsoir Daniel,
J'ai essayé ton code.
Je l'ai placé dans un module.
Lorsque je lance la macro, j'ai le sablier pendant environ 30s, puis plus
rien, et rien n'a été modifié...
André

"Daniel.C" %
Erratum.
Pour des fichiers htm, mettre :
If c.Value & ".htm" = TabloF(i) Then
au lieu de :
If c.Value & ".xls" = TabloF(i) Then
dans la macro Recherche.
Daniel
"Daniel.C"
Bonsoir.
En m'inspirant très largement d'un code de JB auquel il revient une très
grande partie du crédit, utilise le code suivant :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)
racine = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If c.Value & ".xls" = TabloF(i) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".xls" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Cordialement.
Daniel
"AB" %
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens si
tu as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent
par F, et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un
dossier comportant plusieurs sous-dossiers. Les fichiers peuvent donc
être dans un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C, le
chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB























AB
Le #5143031
Bonsoir Daniel,
Pas mieux avec cette version :
La macro bute sur :
Dim fso As Scripting.FileSystemObject
Peut-être est-ce du au fait que je ne l'ai pas placée au bon endroit ?
Y a-t-il des règles à respecter dans ce domaine ?
Merci de ton aide.
André

"Daniel.C"
Bonjour.
Toutes mes excuses, j'avais laissé traîner un ".xls" au lieu d'un ".htm".
J'ai rajouté une sécurité pour ignorer les différences majuscules /
miniscules. C'est normal que la macro soit un peu longue, elle scanne tous
les sous-dossiers du dossier maître :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
Dim fso As Scripting.FileSystemObject
ReDim TabloD(0)
ReDim TabloF(0)

racine = ThisWorkbook.Path
Set fso = New Scripting.FileSystemObject
'Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If UCase(c.Value & ".htm") = UCase(TabloF(i)) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".htm" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Daniel
"AB"
Bonsoir Daniel,
J'ai essayé ton code.
Je l'ai placé dans un module.
Lorsque je lance la macro, j'ai le sablier pendant environ 30s, puis plus
rien, et rien n'a été modifié...
André

"Daniel.C" %
Erratum.
Pour des fichiers htm, mettre :
If c.Value & ".htm" = TabloF(i) Then
au lieu de :
If c.Value & ".xls" = TabloF(i) Then
dans la macro Recherche.
Daniel
"Daniel.C"
Bonsoir.
En m'inspirant très largement d'un code de JB auquel il revient une
très grande partie du crédit, utilise le code suivant :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)
racine = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If c.Value & ".xls" = TabloF(i) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".xls" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Cordialement.
Daniel
"AB" %
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens
si tu as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent
par F, et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un
dossier comportant plusieurs sous-dossiers. Les fichiers peuvent
donc être dans un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C,
le chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB



























Daniel.C
Le #5140761
Juste.
Soit tu coches dans Outils / Références :
"Microsoft Scripting Runtime"
soit tu modifies le code comme suit :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)

racine = ThisWorkbook.Path
'Set fso = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If UCase(c.Value & ".htm") = UCase(TabloF(i)) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".htm" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Daniel
"AB"
Bonsoir Daniel,
Pas mieux avec cette version :
La macro bute sur :
Dim fso As Scripting.FileSystemObject
Peut-être est-ce du au fait que je ne l'ai pas placée au bon endroit ?
Y a-t-il des règles à respecter dans ce domaine ?
Merci de ton aide.
André

"Daniel.C"
Bonjour.
Toutes mes excuses, j'avais laissé traîner un ".xls" au lieu d'un ".htm".
J'ai rajouté une sécurité pour ignorer les différences majuscules /
miniscules. C'est normal que la macro soit un peu longue, elle scanne
tous les sous-dossiers du dossier maître :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
Dim fso As Scripting.FileSystemObject
ReDim TabloD(0)
ReDim TabloF(0)

racine = ThisWorkbook.Path
Set fso = New Scripting.FileSystemObject
'Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If UCase(c.Value & ".htm") = UCase(TabloF(i)) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".htm" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Daniel
"AB"
Bonsoir Daniel,
J'ai essayé ton code.
Je l'ai placé dans un module.
Lorsque je lance la macro, j'ai le sablier pendant environ 30s, puis
plus rien, et rien n'a été modifié...
André

"Daniel.C" %
Erratum.
Pour des fichiers htm, mettre :
If c.Value & ".htm" = TabloF(i) Then
au lieu de :
If c.Value & ".xls" = TabloF(i) Then
dans la macro Recherche.
Daniel
"Daniel.C"
Bonsoir.
En m'inspirant très largement d'un code de JB auquel il revient une
très grande partie du crédit, utilise le code suivant :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)
racine = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If c.Value & ".xls" = TabloF(i) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".xls" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Cordialement.
Daniel
"AB" %
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens
si tu as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent
par F, et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un
dossier comportant plusieurs sous-dossiers. Les fichiers peuvent
donc être dans un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C,
le chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB































AB
Le #5140671
Daniel,
Ca marche parfaitement.
Comme je n'ai jamais plus de 100 lignes dans chaque feuille, j'ai limité le
balayage aux 100 premières lignes : ça va très vite.
Un très grand merci pour ta disponibilité, ta gentillesse, et ton
efficacité.
André


"Daniel.C" %
Juste.
Soit tu coches dans Outils / Références :
"Microsoft Scripting Runtime"
soit tu modifies le code comme suit :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)

racine = ThisWorkbook.Path
'Set fso = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If UCase(c.Value & ".htm") = UCase(TabloF(i)) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".htm" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Daniel
"AB"
Bonsoir Daniel,
Pas mieux avec cette version :
La macro bute sur :
Dim fso As Scripting.FileSystemObject
Peut-être est-ce du au fait que je ne l'ai pas placée au bon endroit ?
Y a-t-il des règles à respecter dans ce domaine ?
Merci de ton aide.
André

"Daniel.C"
Bonjour.
Toutes mes excuses, j'avais laissé traîner un ".xls" au lieu d'un
".htm". J'ai rajouté une sécurité pour ignorer les différences
majuscules / miniscules. C'est normal que la macro soit un peu longue,
elle scanne tous les sous-dossiers du dossier maître :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
Dim fso As Scripting.FileSystemObject
ReDim TabloD(0)
ReDim TabloF(0)

racine = ThisWorkbook.Path
Set fso = New Scripting.FileSystemObject
'Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If UCase(c.Value & ".htm") = UCase(TabloF(i)) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".htm" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Daniel
"AB"
Bonsoir Daniel,
J'ai essayé ton code.
Je l'ai placé dans un module.
Lorsque je lance la macro, j'ai le sablier pendant environ 30s, puis
plus rien, et rien n'a été modifié...
André

"Daniel.C" %
Erratum.
Pour des fichiers htm, mettre :
If c.Value & ".htm" = TabloF(i) Then
au lieu de :
If c.Value & ".xls" = TabloF(i) Then
dans la macro Recherche.
Daniel
"Daniel.C"
Bonsoir.
En m'inspirant très largement d'un code de JB auquel il revient une
très grande partie du crédit, utilise le code suivant :

Public TabloD() As String
Public TabloF() As String

Sub Recherche()
ReDim TabloD(0)
ReDim TabloF(0)
racine = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine
For Each c In Range("B1", Range("B65536").End(xlUp))
For i = 0 To UBound(TabloF) - 1
If c.Value & ".xls" = TabloF(i) Then
c.Offset(, 1) = TabloD(i)
End If
Next i
Next c
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
If Right(f.Name, 4) = ".xls" Then
TabloD(UBound(TabloD)) = dossier.Path
TabloF(UBound(TabloF)) = f.Name
ReDim Preserve TabloD(UBound(TabloD) + 1)
ReDim Preserve TabloF(UBound(TabloF) + 1)
End If
Next
Var = UBound(TabloD)
End Sub

Cordialement.
Daniel
"AB" %
Salut Daniel, et merci de ton aide.
J'ai effectivement la version 2007. J'aurais du le préciser
d'entrée.
André

"Daniel.C"
Bonjour.
Note que la macro ci-dessous ne fonctionne pas avec XL2007. Reviens
si tu as cette version.

Sub Recherche()
Dim Fich As String, c As Range
For Each c In Range("B1", Range("B65536").End(xlUp))
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = ThisWorkbook.Path
.Filename = c.Value & ".xls"
.Execute
If .FoundFiles.Count > 0 Then
c.Offset(, 1) = Left(.FoundFiles(1), _
Len(.FoundFiles(1)) - Len(Dir(.FoundFiles(1))))
End If
End With
Next c
End Sub

Cordialement.
Daniel
"AB" %
Salut à tous,
J'ai en colonne B des valeurs du style : F06002 (toutes commencent
par F, et comportent ensuite 5 chiffres)
Ces valeurs représentent le nom de fichiers .htm qui sont dans un
dossier comportant plusieurs sous-dossiers. Les fichiers peuvent
donc être dans un sous-dossier.
Je voudrais rechercher et introduire automatiquement en colonne C,
le chemin complet d'accès au fichier dont le nom figure en B.
Une idée ?
Merci
AB



































Publicité
Poster une réponse
Anonyme