Sans api , browsefolder

Soyez le premier à donner votre avis sur cette source.

Vue 11 107 fois - Téléchargée 370 fois

Description

Afficher la boite de dialogue Browse Folder sans API Dll et autres......

Source / Exemple :


Private Sub Command1_Click()
Dim objShell, objFolder, chemin, SecuriteSlash, Desk
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
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

      SecuriteSlash = InStr(objFolder.Title, ":")

 If SecuriteSlash > 0 Then
   chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
      Label4.Caption = objFolder.Title
      Label1.Caption = chemin
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

ThePoussin
Messages postés
1
Date d'inscription
mercredi 11 juillet 2007
Statut
Membre
Dernière intervention
4 février 2011
-
Bonjour,

Petite proposition :

Private Function SelectFolder() As String
Dim objShell As Object
Dim objFolder As Object

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Selectionner un répertoire", &H1&)

If Not (objFolder Is Nothing) Then
SelectFolder = objFolder.self.Path

' Ignore les chemins vers la registrie If InStr(1, SelectFolder, ":") 1 Then SelectFolder ""

Set objFolder = Nothing
End If

Set objShell = Nothing
End Function

Pour info, tout objet créé doit être détruit. Et quand vous activez le piège à erreurs 'On Error Resume Next' penser à le gérer et à l'arrêter quand vous ne voulez plus le gérer 'on error goto 0'

Bon code ^^
Straahl
Messages postés
1
Date d'inscription
vendredi 2 juillet 2010
Statut
Membre
Dernière intervention
3 septembre 2010
-
extra!!
merci ça me sauve la vie!!
surfzoid
Messages postés
467
Date d'inscription
vendredi 15 août 2003
Statut
Membre
Dernière intervention
21 avril 2010
-
quel sont les param de la boite de dialogue notamement &H0&, et &H1&, serai ce là pour mettre un rep par def ou même mieu le dernier rep choisi (memorisation)
thx
sinon 8/10
surfzoid
Messages postés
467
Date d'inscription
vendredi 15 août 2003
Statut
Membre
Dernière intervention
21 avril 2010
-
exemple sous xp nickel
Private Sub Command4_Click()
Dim objShell, objFolder, chemin, SecuriteSlash, Desk
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisisser un répertoire serveur", &H1&)
fichier = ""
File1.FileName = ""
File2.FileName = ""
Text1.Text = fichier
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:Documents and SettingsAll UsersBureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
'Frame3.Caption = objFolder.Title
'Label1 = chemin
gVarserveur = chemin
File2.Path = gVarserveur
Dir1.Path = gVarserveur
SaveSetting App.EXEName, "Options", "Serveur", gVarserveur
End Sub
elguevel
Messages postés
735
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
22 novembre 2016
3 -
arf c con ce code ne marche pas sous Windows NT ?

ya t-il un code compatible pour NT / 2000 ??

merci d'avance !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.