[VBA] Browser répertoire [RESOLU] merci ixemul

merci ixemul [VBA] Browser répertoire [RESOLU] - VB/VBA/VBS - Programmation

Marsh Posté le 24-03-2004 à 12:16:24    

:hello: bonjour !
 
il est assez courant sur le net de trouver du code vba/excel permettant de créer un browser type windows pour ouvrir un fichier, récupérer son chemin...etc (tu cliques sur un bouton, le browser s'ouvre, tu choisis ton fichier dans l'arborescence, le fichier s'ouvre, ou du moins le code derrière récupère le chemin du fichier pour pouvoir écrire/lire ...Etc)
 
je cherche ce type de browser mais version répertoire !
et là ça coince, les seuls codes que j'ai pu trouver, était pour du vb pur et faisait appel à du shell, et ça coincait sous vba excel.
je recherche donc un code que je puisse appeler grace à un bouton sur ma feuille excel, je cliques, le browser s'ouvre, je sélectionne un répertoire dans l'arborescence, je récupère le chemin dans mon code dans un string)
 
si vous aviez ça en stock ou un bon site de code source, je suis preneur.
 
merci  :jap:


Message édité par jazzypec le 24-03-2004 à 17:31:18
Reply

Marsh Posté le 24-03-2004 à 12:16:24   

Reply

Marsh Posté le 24-03-2004 à 12:36:52    

Code :
  1. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  2. Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  4. Private Type BrowseInfo
  5.     hWndOwner As Long
  6.     pIDLRoot As Long
  7.     pszDisplayName As Long
  8.     lpszTitle As Long
  9.     ulFlags As Long
  10.     lpfnCallback As Long
  11.     lParam As Long
  12.     iImage As Long
  13. End Type
  15. Private function ChoosePath(title as string) as string
  16. Dim lpIDList As Long
  17. Dim sBuffer As String
  18. Dim szTitle As String
  19. Dim tBrowseInfo As BrowseInfo
  22.     szTitle = title
  23.    
  24.     With tBrowseInfo
  25.         .hWndOwner = Me.hWnd
  26.         .lpszTitle = lstrcat(szTitle, "" )
  27.         .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
  28.     End With
  29.    
  30.     lpIDList = SHBrowseForFolder(tBrowseInfo)
  32.    
  33.     ChoosePath = ""
  34.     If (lpIDList) Then
  35.         sBuffer = Space(MAX_PATH)
  36.         SHGetPathFromIDList lpIDList, sBuffer
  37.         sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
  38.         ChoosePath = sBuffer
  39.     End If
  41. End function


 
Title passé en parametre peut contenir le titre que tu veux affecter a la fenetre de selection de repertoire. Cette Fonction te renvoie le chemin complet du repertoire selectionné ;)

Reply

Marsh Posté le 24-03-2004 à 14:14:29    

ixemul a écrit :

Code :
  1. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  2. Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  4. Private Type BrowseInfo
  5.     hWndOwner As Long
  6.     pIDLRoot As Long
  7.     pszDisplayName As Long
  8.     lpszTitle As Long
  9.     ulFlags As Long
  10.     lpfnCallback As Long
  11.     lParam As Long
  12.     iImage As Long
  13. End Type
  15. Private function ChoosePath(title as string) as string
  16. Dim lpIDList As Long
  17. Dim sBuffer As String
  18. Dim szTitle As String
  19. Dim tBrowseInfo As BrowseInfo
  22.     szTitle = title
  23.    
  24.     With tBrowseInfo
  25.         .hWndOwner = Me.hWnd
  26.         .lpszTitle = lstrcat(szTitle, "" )
  27.         .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
  28.     End With
  29.    
  30.     lpIDList = SHBrowseForFolder(tBrowseInfo)
  32.    
  33.     ChoosePath = ""
  34.     If (lpIDList) Then
  35.         sBuffer = Space(MAX_PATH)
  36.         SHGetPathFromIDList lpIDList, sBuffer
  37.         sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
  38.         ChoosePath = sBuffer
  39.     End If
  41. End function


 
Title passé en parametre peut contenir le titre que tu veux affecter a la fenetre de selection de repertoire. Cette Fonction te renvoie le chemin complet du repertoire selectionné ;)


 
Merci
 
mais j'ai un petit souci, le compilo m'engueule :
 
j'ai copié le code que tu m'as donné dans un module de ma feuille excel, j'appelle la fonction choosepath avec un string en parametre dans la procedure de "monbouton_click" et là il aime pas ce genre de chose :
 
       

Citation :

    With tBrowseInfo
          .hWndOwner = Me.hwnd
          .lpszTitle = lstrcat(szTitle, "" )
          .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
      End With


 
 
 
 
membre de données ou de méthodes introuvables


Message édité par jazzypec le 24-03-2004 à 14:16:26
Reply

Marsh Posté le 24-03-2004 à 14:17:13    

mmhh.. en effet, c'est du VBA/Excel, les fenetres n'ont apparament pas de hwnd :/ (pas sûr, je ne fait que du *VRAI* VB, si j'ose dire :lol:)
 
Essaye sans initialiser le parametre .hwndOwner, ca devrait marcher :)

Reply

Marsh Posté le 24-03-2004 à 15:14:24    

ou sinon regarde du cote de application.hwndowner je sais pas si ca y est dans excel

Reply

Marsh Posté le 24-03-2004 à 15:27:04    

merci encore pour ces conseils !
 
bon maintenant c là qu'il rale :
 
.lpszTitle = lstrcat(szTitle, "" )
 
il me dit qu'il connait pas la fonction


Message édité par jazzypec le 24-03-2004 à 15:27:26
Reply

Marsh Posté le 24-03-2004 à 15:37:03    

jazzypec a écrit :

merci encore pour ces conseils !
 
bon maintenant c là qu'il rale :
 
.lpszTitle = lstrcat(szTitle, "" )
 
il me dit qu'il connait pas la fonction


 
bon en fait après un petit ménage (j'ai viré tout ce qui l'emmerdait)
 
il arrive à m'afficher le browser (nickel merci !)
 
mais il un prob sur un objet/chaine de caractères :
 
          sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
 
message : argument ou appel de procédure incorrect
 
 

Code :
  1. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  2.   Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  3.  
  4.   Private Type BrowseInfo
  5.       hWndOwner As Long
  6.       pIDLRoot As Long
  7.       pszDisplayName As Long
  8.       lpszTitle As Long
  9.       ulFlags As Long
  10.       lpfnCallback As Long
  11.       lParam As Long
  12.       iImage As Long
  13.   End Type
  14. Public Function ChoosePath() As String
  15.   Dim lpIDList As Long
  16.   Dim sBuffer As String
  17.   Dim tBrowseInfo As BrowseInfo
  18.  
  19.  
  20.      
  21.       With tBrowseInfo
  22.           .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
  23.       End With
  24.      
  25.       lpIDList = SHBrowseForFolder(tBrowseInfo)
  26.  
  27.      
  28.       ChoosePath = ""
  29.       If (lpIDList) Then
  30.           sBuffer = Space(MAX_PATH)
  31.           SHGetPathFromIDList lpIDList, sBuffer
  32.           sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
  33.           ChoosePath = sBuffer
  34.       End If
  35.  
  36.   End Function


Message édité par jazzypec le 24-03-2004 à 15:37:25
Reply

Marsh Posté le 24-03-2004 à 16:04:20    

le instr prend au moins 3 arguments en entrée (position de depart, chaine d'origine, chaine a rechercher)  
 
 

Code :
  1. sBuffer = Left(sBuffer, InStr(1,sBuffer, vbNullChar) - 1)


 
;)

Reply

Marsh Posté le 24-03-2004 à 16:13:08    

ixemul a écrit :

le instr prend au moins 3 arguments en entrée (position de depart, chaine d'origine, chaine a rechercher)  
 
 

Code :
  1. sBuffer = Left(sBuffer, InStr(1,sBuffer, vbNullChar) - 1)


 
;)


 
non ça vient pas de là, le instr passe avec ou sans la position de départ
 
à priori le problème est plus "profond"
 
dans ce passage :
 

Code :
  1. If (lpIDList) Then
  2.           sBuffer = Space(MAX_PATH)
  3.           SHGetPathFromIDList lpIDList, sBuffer
  4.           sBuffer = Left(sBuffer, InStr(1, sBuffer, vbNullChar) - 1)
  5.           ChoosePath = sBuffer
  6.       End If


 
je sélectionne mon disque c:
 
le Max_path reste vide et sbuffer également

Reply

Marsh Posté le 24-03-2004 à 16:15:55    

Bon, t'embete pas, remet la syntaxe avec le lstrCat (comme a l'origine de mon bout de code)
 
et rajoute la declaration suivante:
 

Code :
  1. Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Reply

Marsh Posté le 24-03-2004 à 16:15:55   

Reply

Marsh Posté le 24-03-2004 à 16:39:48    

ixemul a écrit :

Bon, t'embete pas, remet la syntaxe avec le lstrCat (comme a l'origine de mon bout de code)
 
et rajoute la declaration suivante:
 

Code :
  1. Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long




 
ça va un poil mieux, il tolère le lstrcat
 
en revanche le max path et le sbuffer reste toujours désespérement vide  
 
dsl pour ce "tutos pas-à-pas", mais je suis peu familier avec une utilisation de VB "évolué", j'ai fait du VB de base à l'iut, et le VBA j'ai débuté y a une ou 2 semaine au taf pour des macros en apprenant sur le tas à coup de google et de msgbox :D
 
donc merci pour ta patience

Reply

Marsh Posté le 24-03-2004 à 16:49:37    

je pense que c'est le instr que le vba a du mal a comprendre. Sinon, je vois pas :/ ce code fonctionne parfaitement dans un prog en pure vb :)

Reply

Marsh Posté le 24-03-2004 à 16:51:31    

non, en fait j'ai oublié de te dire que MAX_PATH est une constante, initialise la avec une valeur genre :
 

Code :
  1. const MAXPATH = 4096


 
a placer juste apres les "declare" ;)

Reply

Marsh Posté le 24-03-2004 à 17:24:28    

ixemul a écrit :

non, en fait j'ai oublié de te dire que MAX_PATH est une constante, initialise la avec une valeur genre :
 

Code :
  1. const MAXPATH = 4096


 
a placer juste apres les "declare" ;)


 
 
 
JE TE HAIS !  :D  :lol:  
 
 
 
Merci !! Ca marche nickel maintenant !
 

Code :
  1. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  2. Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  3. Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  4.  
  5. Const MAX_PATH = 4096
  7.  
  8. Private Type BrowseInfo
  9.       hWndOwner As Long
  10.       pIDLRoot As Long
  11.       pszDisplayName As Long
  12.       lpszTitle As Long
  13.       ulFlags As Long
  14.       lpfnCallback As Long
  15.       lParam As Long
  16.       iImage As Long
  17. End Type
  18.  
  19.   Public Function ChoosePath(title As String) As String
  20.   Dim lpIDList As Long
  21.   Dim sBuffer As String
  22.   Dim szTitle As String
  23.   Dim tBrowseInfo As BrowseInfo
  24.  
  26.       szTitle = title
  27.      
  28.       With tBrowseInfo
  29.           '.hWndOwner = Me.hwnd
  30.           .lpszTitle = lstrcat(szTitle, "" )
  31.           .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
  32.       End With
  33.      
  34.       lpIDList = SHBrowseForFolder(tBrowseInfo)
  35.  
  36.      
  37.       ChoosePath = ""
  38.       If (lpIDList) Then
  39.           sBuffer = Space(MAX_PATH)
  40.           SHGetPathFromIDList lpIDList, sBuffer
  41.           sBuffer = Left(sBuffer, InStr(1, sBuffer, vbNullChar) - 1)
  42.           ChoosePath = sBuffer
  43.       End If
  44.  
  45.   End Function


 
vraiment merci bcp ixemul :jap:  pour ta patience et tes conseils
ça m'a dépanné et permis de rendre ma macro un peu plus "users-friendly" qu'un bon copier-coller de chemin à l'arrache  :D  
 
MERCI  :jap:  
 
merci aussi à axl63800 pour ta participation, j'avais essayé en mettant application mais le compilo m'engueulait, car à priori le .hwnd n'existe pas sous excel


Message édité par jazzypec le 24-03-2004 à 17:28:00
Reply

Marsh Posté le 24-03-2004 à 17:28:00    

yapadkoi :D

Reply

Marsh Posté le 25-03-2004 à 18:19:58    

ct avec plaisir que je t'ai donné un aide inutile!! lol

Reply

Marsh Posté le 19-05-2008 à 13:49:54    

je me permets de upper ce topic
 
j'ai adapté cette solution à ma sauce, c'est exactement ce qu'il me faut sauf que... il faut que j'ouvre un fichier.xls, et non un répertoire.
 
j'ai connement essayé de changer
 
      lpIDList = SHBrowseForFolder(tBrowseInfo)
 
par
 
      lpIDList = SHBrowseForFile(tBrowseInfo)
ou des dialogbox etc... et ça ne marche pas... vous auriez une petite minute à m'accorder?
 
merci d'avance


---------------
Ma vie en Polonie: http://ketchupnchantilly.blogspot.com/
Reply

Marsh Posté le 19-05-2008 à 13:58:26    

Salut ,as-tu essayé

Application.FileDialog(msoFileDialogFolderPicker)


Application.FileDialog (msoFileDialogFilePicker)



Option Explicit
 
Sub Tst()  
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path  & "\"
        .Title = "Sélectionner un Dossier"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            MsgBox .SelectedItems(1)
        End If
    End With
End Sub


Sinon pour la partie personnalisation de SHBrowseForFolder voir http://j-walk.com/ss/excel/tips/tip29.htm


Message édité par kiki29 le 20-05-2008 à 16:49:43
Reply

Marsh Posté le 19-05-2008 à 14:52:59    

merci! c'est parfait.


---------------
Ma vie en Polonie: http://ketchupnchantilly.blogspot.com/
Reply

Marsh Posté le 19-05-2020 à 11:09:57    

salut,  
 
quelqu'un a deja essayer de faire ce programme sous un excel 64bits ?
 
 j ai un problème quand à la conversion de SHGetPathFromIDList en 64 bits : excel crash et se ferme directement  
 
des solutions ?

Reply

Marsh Posté le 19-05-2020 à 14:24:42    

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed