SANS API , BROWSEFOLDER
Don B
-
5 nov. 2001 à 21:53
ThePoussin Messages postés 1 Date d'inscription mercredi 11 juillet 2007 Statut Membre Dernière intervention 4 février 2011 - 4 févr. 2011 à 14:29
ThePoussin Messages postés 1 Date d'inscription mercredi 11 juillet 2007 Statut Membre Dernière intervention 4 février 2011 - 4 févr. 2011 à 14:29
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/345-sans-api-browsefolder
https://codes-sources.commentcamarche.net/source/345-sans-api-browsefolder
4 févr. 2011 à 14:29
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 ^^
3 sept. 2010 à 10:14
merci ça me sauve la vie!!
2 déc. 2003 à 23:36
thx
sinon 8/10
2 déc. 2003 à 23:31
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
23 sept. 2003 à 15:53
ya t-il un code compatible pour NT / 2000 ??
merci d'avance !
5 nov. 2001 à 21:53