GetOpenFilename

Le
MiMa
Bonjour et bonne année à tous

je souhaite récupérer le chemin d'un dossier existant par macro.
La méthode "Application.GetOpenFilename" donne la possibilité d'extraire le
chemin du dossier à partir de celui d'un fichier, mais, lorsque le dossier
ne contient pas de fichier, cette méthode ne peux pas être utilisée et
renvoi faux car il n'y a rien à sélectionner.

Quelle méthode faut-il utiliser pour obtenir le même résultat que dans la
barre d'adresse de l'explorateur ?
Merci d'avance
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
michdenis
Le #20887451
Bonjour,

'--------------------------------------------
Sub test()
Dim Rep As String
'Le répertoire de départ(dossier racine)
Rep = "c:UsersDM"
Rep = ChoixDossier("c:UsersDM")
End Sub
'--------------------------------------------

Et dans un module standard :
'--------------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
Msg = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H4000, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossier = Chemin
End Function
'--------------------------------------------




"MiMa" 4b40ce8e$0$9206$
Bonjour et bonne année à tous

je souhaite récupérer le chemin d'un dossier existant par macro.
La méthode "Application.GetOpenFilename" donne la possibilité d'extraire le
chemin du dossier à partir de celui d'un fichier, mais, lorsque le dossier
ne contient pas de fichier, cette méthode ne peux pas être utilisée et
renvoi faux car il n'y a rien à sélectionner.

Quelle méthode faut-il utiliser pour obtenir le même résultat que dans la
barre d'adresse de l'explorateur ?
Merci d'avance
Herdet
Le #20887611
Bonjour,
Ci-après une méthode simple à adapter bien sûr.
Cordialement

Robert
'-------------------------------
APPEL -----------------------------------------------------------
Sub BTN_selectRep()
Rep = ChoixDossierFichier("")
MsgBox Rep
End Sub
'---------------------------------
FONCTION ----------------------------------------------------------
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$

FlagChoix = &H1&
Msg = "Répertoire d'enregistrement"

Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir la sélection d'un dossier ou
d'un fichier (0 ou 1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, 0, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

ChoixDossierFichier = Chemin
End Function

"MiMa" 4b40ce8e$0$9206$
Bonjour et bonne année à tous

je souhaite récupérer le chemin d'un dossier existant par macro.
La méthode "Application.GetOpenFilename" donne la possibilité d'extraire
le chemin du dossier à partir de celui d'un fichier, mais, lorsque le
dossier ne contient pas de fichier, cette méthode ne peux pas être
utilisée et renvoi faux car il n'y a rien à sélectionner.

Quelle méthode faut-il utiliser pour obtenir le même résultat que dans la
barre d'adresse de l'explorateur ?
Merci d'avance




michdenis
Le #20887601
Tu as aussi cette méthode :

'Déclaration des variables et API dans le haut d'un module standard
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 Function BrowseFolder(strDialogTitle As String) As String

On Error GoTo ErrorHandling_Err

' ------------------------------------------------------------------------
' Purpose: Example of how to use the Browse folder dialog
'
' Accepts: strDialogTitle as the title for the browser folder dialog
'
' Returns: The selected folder/path
'
' Example usage:
' strRetVal$= BrowseFolder("What folder is the file in?")
' ------------------------------------------------------------------------

Dim lRetVal As Long
Dim bi As BROWSEINFO
Dim dwIList As Long
Dim strPath As String
Dim iPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = strDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
strPath = Space$(512)
lRetVal = SHGetPathFromIDList(ByVal dwIList, ByVal strPath)

If lRetVal Then
iPos = InStr(strPath, Chr(0))
BrowseFolder = Left$(strPath, iPos - 1)
Else
BrowseFolder = ""
End If
ErrorHandling_Err:
If Err Then
'Trap your error(s) here, if any!
End If
End Function

'---------------------------------
Sub test()
strRetVal$ = BrowseFolder("Votre explorateur")
End Sub
'---------------------------------
michdenis
Le #20887751
Au besoin, il y a aussi cette approche :

'----------------------------------------
Sub test()
Répertoire = ChoixDossier("Répertoire = ChoixDossier("C:UsersDM")
End Sub
'----------------------------------------

Et dans un module standard :
'----------------------------------------
Function ChoixDossier(Depart As String)
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Depart
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
'----------------------------------------



"michdenis"
Tu as aussi cette méthode :

'Déclaration des variables et API dans le haut d'un module standard
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 Function BrowseFolder(strDialogTitle As String) As String

On Error GoTo ErrorHandling_Err

' ------------------------------------------------------------------------
' Purpose: Example of how to use the Browse folder dialog
'
' Accepts: strDialogTitle as the title for the browser folder dialog
'
' Returns: The selected folder/path
'
' Example usage:
' strRetVal$= BrowseFolder("What folder is the file in?")
' ------------------------------------------------------------------------

Dim lRetVal As Long
Dim bi As BROWSEINFO
Dim dwIList As Long
Dim strPath As String
Dim iPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = strDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
strPath = Space$(512)
lRetVal = SHGetPathFromIDList(ByVal dwIList, ByVal strPath)

If lRetVal Then
iPos = InStr(strPath, Chr(0))
BrowseFolder = Left$(strPath, iPos - 1)
Else
BrowseFolder = ""
End If
ErrorHandling_Err:
If Err Then
'Trap your error(s) here, if any!
End If
End Function

'---------------------------------
Sub test()
strRetVal$ = BrowseFolder("Votre explorateur")
End Sub
'---------------------------------
Mima
Le #20893861
Bonjour MichDenis

Merci pour ces différentes approches qui correspondent à ce que je
souhaitais.
La solution un et la trois fonctionne bien, mais dans celle décrite ci
dessous, la ligne :
.hOwner = hWndAccessApp
renvoi un message d'erreur : hWndAccessApp : variable non définie.
Je suppose qu'il faut déclarer une référence, mais je ne voie pas laquelle !




"michdenis"
Tu as aussi cette méthode :

'Déclaration des variables et API dans le haut d'un module standard
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 Function BrowseFolder(strDialogTitle As String) As String

On Error GoTo ErrorHandling_Err

' ------------------------------------------------------------------------
' Purpose: Example of how to use the Browse folder dialog
'
' Accepts: strDialogTitle as the title for the browser folder dialog
'
' Returns: The selected folder/path
'
' Example usage:
' strRetVal$= BrowseFolder("What folder is the file in?")
' ------------------------------------------------------------------------

Dim lRetVal As Long
Dim bi As BROWSEINFO
Dim dwIList As Long
Dim strPath As String
Dim iPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = strDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
strPath = Space$(512)
lRetVal = SHGetPathFromIDList(ByVal dwIList, ByVal strPath)

If lRetVal Then
iPos = InStr(strPath, Chr(0))
BrowseFolder = Left$(strPath, iPos - 1)
Else
BrowseFolder = ""
End If
ErrorHandling_Err:
If Err Then
'Trap your error(s) here, if any!
End If
End Function

'---------------------------------
Sub test()
strRetVal$ = BrowseFolder("Votre explorateur")
End Sub
'---------------------------------







Mima
Le #20893851
Merci Robert, c'est supper



"Herdet"
Bonjour,
Ci-après une méthode simple à adapter bien sûr.
Cordialement

Robert
'-------------------------------
APPEL -----------------------------------------------------------
Sub BTN_selectRep()
Rep = ChoixDossierFichier("")
MsgBox Rep
End Sub
'---------------------------------
FONCTION ----------------------------------------------------------
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$

FlagChoix = &H1&
Msg = "Répertoire d'enregistrement"

Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir la sélection d'un dossier ou
d'un fichier (0 ou 1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, 0, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

ChoixDossierFichier = Chemin
End Function

"MiMa" 4b40ce8e$0$9206$
Bonjour et bonne année à tous

je souhaite récupérer le chemin d'un dossier existant par macro.
La méthode "Application.GetOpenFilename" donne la possibilité d'extraire
le chemin du dossier à partir de celui d'un fichier, mais, lorsque le
dossier ne contient pas de fichier, cette méthode ne peux pas être
utilisée et renvoi faux car il n'y a rien à sélectionner.

Quelle méthode faut-il utiliser pour obtenir le même résultat que dans la
barre d'adresse de l'explorateur ?
Merci d'avance






michdenis
Le #20893821
| .hOwner = hWndAccessApp

La macro telle qu'elle est écrite ne renvoie aucun message d'erreur
testée sous Excel 2003 et 2007 avec Windows7.

à la limite, met cette ligne de code en commentaire ...
Publicité
Poster une réponse
Anonyme