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

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA] Browser répertoire [RESOLU] merci ixemul

jazzypec

Everybody wants to be a cat

: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

Publicité

ixemul

Nan mais sans blague ! ⚡

Code :

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private function ChoosePath(title as string) as string
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = title
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "" )
.ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
ChoosePath = ""
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
ChoosePath = sBuffer
End If
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é

jazzypec

Everybody wants to be a cat

ixemul a écrit :

Code :

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private function ChoosePath(title as string) as string
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = title
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "" )
.ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
ChoosePath = ""
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
ChoosePath = sBuffer
End If
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

ixemul

Nan mais sans blague ! ⚡

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

axl63800

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

jazzypec

Everybody wants to be a cat

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

jazzypec

Everybody wants to be a cat

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 :

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Function ChoosePath() As String
Dim lpIDList As Long
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
With tBrowseInfo
.ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
ChoosePath = ""
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
ChoosePath = sBuffer
End If
End Function

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

ixemul

Nan mais sans blague ! ⚡

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

Code :

sBuffer = Left(sBuffer, InStr(1,sBuffer, vbNullChar) - 1)

jazzypec

Everybody wants to be a cat

ixemul a écrit :

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

Code :

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 :

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(1, sBuffer, vbNullChar) - 1)
ChoosePath = sBuffer
End If

je sélectionne mon disque c:

le Max_path reste vide et sbuffer également

ixemul

Nan mais sans blague ! ⚡

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 :

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

Publicité

jazzypec

Everybody wants to be a cat

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 :

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

donc merci pour ta patience

ixemul

Nan mais sans blague ! ⚡

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

ixemul

Nan mais sans blague ! ⚡

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

Code :

const MAXPATH = 4096

a placer juste apres les "declare"

jazzypec

Everybody wants to be a cat

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 :

const MAXPATH = 4096

a placer juste apres les "declare"

JE TE HAIS ! :lol:

Merci !! Ca marche nickel maintenant !

Code :

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Const MAX_PATH = 4096
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Function ChoosePath(title As String) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = title
With tBrowseInfo
'.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "" )
.ulFlags = BIF_RETURNONLYFSDIRS '+ BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
ChoosePath = ""
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(1, sBuffer, vbNullChar) - 1)
ChoosePath = sBuffer
End If
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

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

ixemul

Nan mais sans blague ! ⚡

yapadkoi

axl63800

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

Biroute

j'aime les andouillettes !:op

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/

kiki29

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

Biroute

j'aime les andouillettes !:op

merci! c'est parfait.

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

jere54-xd

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 ?

patrice33740

Avec la réponse, c'est facile.

Bonjour,

Regardes ici :
https://arkham46.developpez.com/art [...] vba64bits/
https://docs.microsoft.com/en-us/of [...] s-overview

---------------
Cordialement, Patrice

Publicité

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

Page générée en 0.087 secondes