Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel macro pour recherche automatique de chemin d'accès à un fichier

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

9 réponses
Avatar
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
Signaler un problème avec ce contenu

9 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
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" a écrit dans le message de news:
%
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



Avatar
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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







Avatar
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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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











Avatar
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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















Avatar
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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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



















Avatar
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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























Avatar
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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



























Avatar
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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































Avatar
AB
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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:

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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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" a écrit dans le message de news:

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" a écrit dans le message de news:
%
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