Parcourir l'arborescence Windows depuis Access

Bonjour

Comment faire un "Parcourir" (browse) pour rechercher un fichier et
récupérer son chemin dans un contrôle de formulaire Access ?
Merci.

pour chercher un fichier :
http://access.jessy.free.fr/index.html?Menu=6&Page=OpenFile

et pour chercher un répertoire :
http://access.jessy.free.fr/index.html?Menu=6&Page=GetDirectory

@+
Jessy Sempere - Access MVP
news@access.fr.vu
------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------

Bonjour,
Pour commencer tu creer un module dans vb comme suit :

Option Compare Database
Option Explicit

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
LParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList
Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder
Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1

Public Const OFN_AllowMultiSelect = &H200
Public Const OFN_CreatePrompt = &H2000
Public Const OFN_EnableHook = &H20
Public Const OFN_EnableTemplate = &H40
Public Const OFN_EnableTemplateHandle = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_ExtensionDifferent = &H400
Public Const OFN_FileMustExist = &H1000
Public Const OFN_HideReadOnly = &H4
Public Const OFN_LongNames = &H200000
Public Const OFN_NoChangeDir = &H8
Public Const OFN_NoDeReferenceLinks = &H100000
Public Const OFN_NoLongNames = &H40000
Public Const OFN_NoNetWorkButton = &H20000
Public Const OFN_NoReadOnlyReturn = &H8000
Public Const OFN_NoTestFileCreate = &H10000
Public Const OFN_NoValiDate = &H100
Public Const OFN_OverWritePrompt = &H2
Public Const OFN_PathMustExist = &H800
Public Const OFN_ReadOnly = &H1
Public Const OFN_ShareAware = &H4000
Public Const OFN_ShareFallThrough = 2
Public Const OFN_ShareNoWarn = 1
Public Const OFN_ShareWarn = 0
Public Const OFN_ShowHelp = &H10
Public Dialogue As OpenFileName

Public strFiltre As String
Public strFile As String
Public strNomFile As String
Public RetVal As Long


Public Type OpenFileName
lStructSize As Long
hwndOwner As Long
Instance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpRépertoire_initial As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Declare Function GetOpenFileName Lib "comdlg32.dll"
_
Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName)
As Long

Public Declare Function GetSaveFileName Lib "comdlg32.dll"
_
Alias "GetSaveFileNameA" (pOpenfilename As OpenFileName)
As Long

Public Function SelectFolder() As String
Dim x As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = "Sélectionnez votre dossier et cliquez sur OK"
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If x Then
wPos = InStr(szPath, Chr(0))
SelectFolder = Left$(szPath, wPos - 1)
Else
SelectFolder = ""
End If
End Function

Public Function OpenFile(Répertoire_initial As String) As
String

OpenFile = ""

strFiltre = "Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0)
& _
"Fichiers Word" & Chr$(0) & "*.doc;*txt" & Chr$(0) & _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"

With Dialogue
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpRépertoire_initial = "" 'Répertoire_initial
.lpstrTitle = "Recherche d'un fichier"
.Flags = 6148
End With

RetVal = GetOpenFileName(Dialogue)

If RetVal >= 1 Then
OpenFile = Trim(Dialogue.lpstrFile)
Else
Exit Function
End If

End Function

Ensuite dans ton formulaire tu creer un bouton et une zone
de texte

Si tu veux recuperer le lien vers un dossier la fonction
sur click du bouton sera :

Lien = SelectFolder (Lien est le nom de la zone de
texte)

Si tu veux recuperer le chemin d un fichier :

Lien = OpenFile("mes documents")

dans les 2 cas un explorateur de document te permet de
recuperer la selection