Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1475 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

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

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

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

n°682485
jazzypec
Everybody wants to be a cat
Posté le 24-03-2004 à 12:16:24  profilanswer
 

: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
mood
Publicité
Posté le 24-03-2004 à 12:16:24  profilanswer
 

n°682512
ixemul
Nan mais sans blague ! ⚡
Posté le 24-03-2004 à 12:36:52  profilanswer
 

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 Type BrowseInfo
  4.     hWndOwner As Long
  5.     pIDLRoot As Long
  6.     pszDisplayName As Long
  7.     lpszTitle As Long
  8.     ulFlags As Long
  9.     lpfnCallback As Long
  10.     lParam As Long
  11.     iImage As Long
  12. End Type
  13. Private function ChoosePath(title as string) as string
  14. Dim lpIDList As Long
  15. Dim sBuffer As String
  16. Dim szTitle As String
  17. Dim tBrowseInfo As BrowseInfo
  18.     szTitle = title
  19.    
  20.     With tBrowseInfo
  21.         .hWndOwner = Me.hWnd
  22.         .lpszTitle = lstrcat(szTitle, "" )
  23.         .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
  24.     End With
  25.    
  26.     lpIDList = SHBrowseForFolder(tBrowseInfo)
  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. 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é ;)

n°682745
jazzypec
Everybody wants to be a cat
Posté le 24-03-2004 à 14:14:29  profilanswer
 

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
  3. Private Type BrowseInfo
  4.     hWndOwner As Long
  5.     pIDLRoot As Long
  6.     pszDisplayName As Long
  7.     lpszTitle As Long
  8.     ulFlags As Long
  9.     lpfnCallback As Long
  10.     lParam As Long
  11.     iImage As Long
  12. End Type
  13. Private function ChoosePath(title as string) as string
  14. Dim lpIDList As Long
  15. Dim sBuffer As String
  16. Dim szTitle As String
  17. Dim tBrowseInfo As BrowseInfo
  18.     szTitle = title
  19.    
  20.     With tBrowseInfo
  21.         .hWndOwner = Me.hWnd
  22.         .lpszTitle = lstrcat(szTitle, "" )
  23.         .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
  24.     End With
  25.    
  26.     lpIDList = SHBrowseForFolder(tBrowseInfo)
  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. 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
n°682751
ixemul
Nan mais sans blague ! ⚡
Posté le 24-03-2004 à 14:17:13  profilanswer
 

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 :)

n°682856
axl63800
Posté le 24-03-2004 à 15:14:24  profilanswer
 

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

n°682887
jazzypec
Everybody wants to be a cat
Posté le 24-03-2004 à 15:27:04  profilanswer
 

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
n°682913
jazzypec
Everybody wants to be a cat
Posté le 24-03-2004 à 15:37:03  profilanswer
 

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
n°682953
ixemul
Nan mais sans blague ! ⚡
Posté le 24-03-2004 à 16:04:20  profilanswer
 

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)


 
;)

n°682967
jazzypec
Everybody wants to be a cat
Posté le 24-03-2004 à 16:13:08  profilanswer
 

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

n°682969
ixemul
Nan mais sans blague ! ⚡
Posté le 24-03-2004 à 16:15:55  profilanswer
 

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

mood
Publicité
Posté le 24-03-2004 à 16:15:55  profilanswer
 

n°683006
jazzypec
Everybody wants to be a cat
Posté le 24-03-2004 à 16:39:48  profilanswer
 

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

n°683023
ixemul
Nan mais sans blague ! ⚡
Posté le 24-03-2004 à 16:49:37  profilanswer
 

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 :)

n°683025
ixemul
Nan mais sans blague ! ⚡
Posté le 24-03-2004 à 16:51:31  profilanswer
 

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" ;)

n°683050
jazzypec
Everybody wants to be a cat
Posté le 24-03-2004 à 17:24:28  profilanswer
 

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
  6.  
  7. Private Type BrowseInfo
  8.       hWndOwner As Long
  9.       pIDLRoot As Long
  10.       pszDisplayName As Long
  11.       lpszTitle As Long
  12.       ulFlags As Long
  13.       lpfnCallback As Long
  14.       lParam As Long
  15.       iImage As Long
  16. End Type
  17.  
  18.   Public Function ChoosePath(title As String) As String
  19.   Dim lpIDList As Long
  20.   Dim sBuffer As String
  21.   Dim szTitle As String
  22.   Dim tBrowseInfo As BrowseInfo
  23.  
  24.       szTitle = title
  25.      
  26.       With tBrowseInfo
  27.           '.hWndOwner = Me.hwnd
  28.           .lpszTitle = lstrcat(szTitle, "" )
  29.           .ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
  30.       End With
  31.      
  32.       lpIDList = SHBrowseForFolder(tBrowseInfo)
  33.  
  34.      
  35.       ChoosePath = ""
  36.       If (lpIDList) Then
  37.           sBuffer = Space(MAX_PATH)
  38.           SHGetPathFromIDList lpIDList, sBuffer
  39.           sBuffer = Left(sBuffer, InStr(1, sBuffer, vbNullChar) - 1)
  40.           ChoosePath = sBuffer
  41.       End If
  42.  
  43.   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
n°683056
ixemul
Nan mais sans blague ! ⚡
Posté le 24-03-2004 à 17:28:00  profilanswer
 

yapadkoi :D

n°684199
axl63800
Posté le 25-03-2004 à 18:19:58  profilanswer
 

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

n°1733698
Biroute
j'aime les andouillettes !:op
Posté le 19-05-2008 à 13:49:54  profilanswer
 

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/
n°1733711
kiki29
Posté le 19-05-2008 à 13:58:26  profilanswer
 

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
n°1733758
Biroute
j'aime les andouillettes !:op
Posté le 19-05-2008 à 14:52:59  profilanswer
 

merci! c'est parfait.


---------------
Ma vie en Polonie: http://ketchupnchantilly.blogspot.com/
n°2354055
jere54-xd
Posté le 19-05-2020 à 11:09:57  profilanswer
 

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 ?

n°2354075
patrice337​40
Avec la réponse, c'est facile.
Posté le 19-05-2020 à 14:24:42  profilanswer
 
mood
Publicité
Posté le   profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

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

 

Sujets relatifs
envoi mail (VBA) avec outlook express[résolu]lancement de requetes contenu dans des fichiers texte (vb6)
[PHP] [resolu] retrouver la date du premier jour d 1 num de semaine[HTML] est-il possible de locker un champ texte [résolu]
Browser de code C[RESOLU][JS]Transmettre une liste d'elements vers une autre page
[résolu]pour chaque élement sélectionné de ma listbox fair...[résolu]ouverture fichier excel plus possible
[batch] Récupérer le dernier fichier créé d'un répertoire[Question] Socket (résolu)
Plus de sujets relatifs à : [VBA] Browser répertoire [RESOLU] merci ixemul


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR