Ouverture répertoire avec recherche chemin

[frank35]

Bonjour à tous,
J'ai un fichier source xls (c:\???\source.xls) qui est situé en amont de toute une arborescence de répertoire (c:\???\dossier\dossierN+1\dossierN+2...). Dans ce fichier source, je souhaite ouvrir des répertoires ou fichiers : OK facile mais voilà la difficulté : l'emplacement de l'ensemble de l'arborescence des répertoires est susceptible de changer (suivant les utilisateurs). Je souhaite donc que lorsque je demande l'ouverture du dossierN+3 par exemple la macro recherche déjà l'emplacement du fichier source (c:\???\) et que ce chemin se rajoute au reste (dossier\dossierN+1\dossierN+2...).
J'espère que c'est clair 😱
Merci de votre aide.
Salutations,
Frank

 

[excalibur]

Re : Ouverture répertoire avec recherche chemin

bonjour franck le forum une macro de f.sigonneau a adapter si j ai compris??

Option Explicit
Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" _
(ByVal lpRootPath As String, _
ByVal lpInputName As String, _
ByVal lpOutputName As String) As Long
Public Const MAX_PATH = 260
'exemple
Sub test()
MsgBox FindFile("c:", "essai.xls")
MsgBox FindFile("c:\", "essai.xls")
MsgBox FindFile("", "essai.xls")
End Sub
Public Function FindFile(RootPath As String, FileName As String) As String
'Karl Moore, Ce lien n'existe plus
Dim lNullPos As Long
Dim lResult As Long
Dim sBuffer As String
On Error GoTo FileFind_Error
'fournit par défaut le lecteur courant si non spécifié (fs)
If RootPath = "" Then RootPath = Left$(CurDir, 3)
'Allocate buffer
sBuffer = Space(MAX_PATH * 2)
'Find the file
lResult = SearchTreeForFile(RootPath, FileName, sBuffer)
'Trim null, if exists
If lResult Then
lNullPos = InStr(sBuffer, vbNullChar)
If Not lNullPos Then
sBuffer = Left(sBuffer, lNullPos - 1)
End If
'Return filename
FindFile = sBuffer
Else
'Nothing found
FindFile = vbNullString
End If
Exit Function
FileFind_Error:
FindFile = vbNullString
End Function