Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 12 PS5 Orange Livebox ChatGPT Mini PC
Entraide Applications Microsoft Office Excel GetOpenFilename

GetOpenFilename

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

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




Avatar
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
'---------------------------------
Avatar
michdenis
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" a écrit dans le message de groupe de discussion :

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

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
'---------------------------------







Avatar
Mima
Merci Robert, c'est supper



"Herdet" a écrit dans le message de news:

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






Avatar
michdenis
| .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 ...