Séselectiom un répertoire sur le réseau

François Picalausa

10/08/2004 à 21:25

Hello,

Tu peux essayer le flag BIF_SHAREABLE:
Version 5.0. The browse dialog box can display shareable resources on remote
systems. It is intended for applications that want to expose remote shares
on a local system. The BIF_NEWDIALOGSTYLE flag must also be set.

Les correspondances de versions sont indiquées ici:
http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/programmersguide/versions.asp

Les flags sont:
Private Enum BIF
BIF_RETURNONLYFSDIRS = &H1
BIF_DONTGOBELOWDOMAIN = &H2
BIF_STATUSTEXT = &H4
BIF_RETURNFSANCESTORS = &H8
BIF_EDITBOX = &H10
BIF_VALIDATE = &H20
BIF_NEWDIALOGSTYLE = &H40
BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
BIF_BROWSEINCLUDEURLS = &H80
BIF_UAHINT = &H100
BIF_NONEWFOLDERBUTTON = &H200
BIF_NOTRANSLATETARGETS = &H400
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
BIF_BROWSEINCLUDEFILES = &H4000
BIF_SHAREABLE = &H8000
End Enum

--
François Picalausa (MVP VB)
http://faq.vb.free.fr --- http://msdn.microsoft.com
http://apisvb.europe.webmatrixhosting.net

"Patrick" a écrit dans le message de
news:

J'utilise dans le code VB la boite de dialogue Windows pour
sélectionner un répertoire. Mais je voudrais aussi pouvoir
sélectionner un répertoire qui est sur le réseau en sélectionnant son
chemin complet. Mais apparemment la boite de dialogue ne permet pas
de le faire.

ng

10/08/2004 à 21:40

Salut,

Essaye avec la méthode ShowNetworkFolder() de ce module :

Option Explicit
Public Enum OFN_Constants
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_DONTADDTORECENT = &H2000000
OFN_ENABLEHOOK = &H20
OFN_ENABLEINCLUDENOTIFY = &H400000
OFN_ENABLESIZING = &H800000
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EX_NOPLACESBAR = &H1
OFN_EXPLORER = &H80000
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_FORCESHOWHIDDEN = &H10000000
OFN_HIDEREADONLY = &H4
OFN_LONGNAMES = &H200000
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHARENOWARN = 1
OFN_SHAREWARN = 0
OFN_SHOWHELP = &H10
OFN_USEMONIKERS = &H1000000
End Enum

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
strDisplayName As String
strTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Const CSIDL_NETWORK = &H12
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_BROWSEFORCOMPUTER = &H1000
Const MAX_PATH = 260

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 GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA"
(pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal
hwndOwner As Long, ByVal Folder As Long, ByRef IDL As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As
Long
Dim CustomColors() As Byte
Public Function OpenFileDialog(Optional DialogTitle As String, Optional
sFilter As String, Optional flags As OFN_Constants, Optional InitialDir As
String, Optional hwndOwner As Long) As String
Dim OFName As OPENFILENAME
With OFName
.lStructSize = Len(OFName)
.hwndOwner = hwndOwner
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = InitialDir
.lpstrTitle = DialogTitle
.flags = flags
End With
If GetOpenFileName(OFName) Then
OpenFileDialog = Trim$(OFName.lpstrFile)
If Asc(Right$(OpenFileDialog, 1)) = 0 Then OpenFileDialog Left$(OpenFileDialog, Len(OpenFileDialog) - 1)
Else
OpenFileDialog = ""
End If
End Function
Public Function ShowSave(Optional DialogTitle As String, Optional sFilter As
String, Optional flags As OFN_Constants, Optional InitialDir As String,
Optional hwndOwner As Long) As String
Dim OFName As OPENFILENAME
With OFName
.lStructSize = Len(OFName)
.hwndOwner = hwndOwner
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = InitialDir
.lpstrTitle = DialogTitle
.flags = flags
End With
If GetSaveFileName(OFName) Then
ShowSave = Trim$(OFName.lpstrFile)
If Asc(Right$(ShowSave, 1)) = 0 Then ShowSave = Left$(ShowSave,
Len(ShowSave) - 1)
Else
ShowSave = ""
End If
End Function

Public Function ShowColor(hWndForm As Long) As Long
Dim cc As CHOOSECOLOR
With cc
.lStructSize = Len(cc)
.hwndOwner = hWndForm
.hInstance = App.hInstance
.lpCustColors = StrConv(CustomColors, vbUnicode)
.flags = 0
End With
If CHOOSECOLOR(cc) <> 0 Then
ShowColor = cc.rgbResult
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
Else
ShowColor = -1
End If
End Function

Public Sub InitCommonControlsAndDialogs()
Call InitCommonControls
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
Dim i As Integer
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
End Sub

Public Function ShowFolder(FormhWnd As Long, sTitre As String) As String
Dim sChe As String
Call BrowseForFolder(0, BIF_RETURNONLYFSDIRS, sChe, sTitre, FormhWnd)
If Right$(sChe, 1) <> "" Then sChe = sChe & ""
ShowFolder = sChe
End Function
Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As String) As
String
Dim sChe As String
Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER, sChe, sTitre,
FormhWnd)
ShowNetworkFolder = sChe
End Function
Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal lngBifFlags
As Long, ByRef strFolder As String, Optional ByVal strTitle As String "Select Folder", Optional ByVal hWnd As Long = 0) As Long
Dim bi As BROWSEINFO
Dim lngReturn As Long
Dim lngIDL As Long
If SHGetSpecialFolderLocation(hWnd, lngCSIdl, lngIDL) = 0 Then
With bi
.hwndOwner = hWnd
.pidlRoot = lngIDL
.strDisplayName = Space$(MAX_PATH)
.strTitle = strTitle
.ulFlags = lngBifFlags
End With
lngIDL = SHBrowseForFolder(bi)
If lngIDL <> 0 Then
strFolder = Space(MAX_PATH)
If CBool(SHGetPathFromIDList(lngIDL, strFolder)) Then
strFolder = TrimNull(strFolder)
lngReturn = 0&
Else
strFolder = TrimNull(bi.strDisplayName)
lngReturn = 0&
End If
Else
lngReturn = 1208&
End If
Call GlobalFree(lngIDL)
Else
lngReturn = 1208&
End If
BrowseForFolder = lngReturn
End Function

Private Function TrimNull(ByVal strValue As String) As String
Dim intPos As Integer
intPos = InStr(strValue, vbNullChar)
Select Case intPos
Case Is > 1
TrimNull = Left$(strValue, intPos - 1)
Case 0
TrimNull = strValue
Case 1
TrimNull = ""
End Select
End Function

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

Patrick a écrit :

Bonjour,

J'utilise dans le code VB la boite de dialogue Windows pour
sélectionner un répertoire. Mais je voudrais aussi pouvoir
sélectionner un répertoire qui est sur le réseau en sélectionnant son
chemin complet. Mais apparemment la boite de dialogue ne permet pas
de le faire. Savez-vous pourquoi ?

Merci pour votre aide.

Salut,

Essaye avec la méthode ShowNetworkFolder() de ce module :

Option Explicit
Public Enum OFN_Constants
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_DONTADDTORECENT = &H2000000
OFN_ENABLEHOOK = &H20
OFN_ENABLEINCLUDENOTIFY = &H400000
OFN_ENABLESIZING = &H800000
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EX_NOPLACESBAR = &H1
OFN_EXPLORER = &H80000
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_FORCESHOWHIDDEN = &H10000000
OFN_HIDEREADONLY = &H4
OFN_LONGNAMES = &H200000
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHARENOWARN = 1
OFN_SHAREWARN = 0
OFN_SHOWHELP = &H10
OFN_USEMONIKERS = &H1000000
End Enum

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
strDisplayName As String
strTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Const CSIDL_NETWORK = &H12
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_BROWSEFORCOMPUTER = &H1000
Const MAX_PATH = 260

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 GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA"
(pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal
hwndOwner As Long, ByVal Folder As Long, ByRef IDL As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As
Long
Dim CustomColors() As Byte
Public Function OpenFileDialog(Optional DialogTitle As String, Optional
sFilter As String, Optional flags As OFN_Constants, Optional InitialDir As
String, Optional hwndOwner As Long) As String
Dim OFName As OPENFILENAME
With OFName
.lStructSize = Len(OFName)
.hwndOwner = hwndOwner
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = InitialDir
.lpstrTitle = DialogTitle
.flags = flags
End With
If GetOpenFileName(OFName) Then
OpenFileDialog = Trim$(OFName.lpstrFile)
If Asc(Right$(OpenFileDialog, 1)) = 0 Then OpenFileDialog Left$(OpenFileDialog, Len(OpenFileDialog) - 1)
Else
OpenFileDialog = ""
End If
End Function
Public Function ShowSave(Optional DialogTitle As String, Optional sFilter As
String, Optional flags As OFN_Constants, Optional InitialDir As String,
Optional hwndOwner As Long) As String
Dim OFName As OPENFILENAME
With OFName
.lStructSize = Len(OFName)
.hwndOwner = hwndOwner
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = InitialDir
.lpstrTitle = DialogTitle
.flags = flags
End With
If GetSaveFileName(OFName) Then
ShowSave = Trim$(OFName.lpstrFile)
If Asc(Right$(ShowSave, 1)) = 0 Then ShowSave = Left$(ShowSave,
Len(ShowSave) - 1)
Else
ShowSave = ""
End If
End Function

Public Function ShowColor(hWndForm As Long) As Long
Dim cc As CHOOSECOLOR
With cc
.lStructSize = Len(cc)
.hwndOwner = hWndForm
.hInstance = App.hInstance
.lpCustColors = StrConv(CustomColors, vbUnicode)
.flags = 0
End With
If CHOOSECOLOR(cc) <> 0 Then
ShowColor = cc.rgbResult
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
Else
ShowColor = -1
End If
End Function

Public Sub InitCommonControlsAndDialogs()
Call InitCommonControls
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
Dim i As Integer
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
End Sub

Public Function ShowFolder(FormhWnd As Long, sTitre As String) As String
Dim sChe As String
Call BrowseForFolder(0, BIF_RETURNONLYFSDIRS, sChe, sTitre, FormhWnd)
If Right$(sChe, 1) <> "" Then sChe = sChe & ""
ShowFolder = sChe
End Function
Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As String) As
String
Dim sChe As String
Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER, sChe, sTitre,
FormhWnd)
ShowNetworkFolder = sChe
End Function
Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal lngBifFlags
As Long, ByRef strFolder As String, Optional ByVal strTitle As String "Select Folder", Optional ByVal hWnd As Long = 0) As Long
Dim bi As BROWSEINFO
Dim lngReturn As Long
Dim lngIDL As Long
If SHGetSpecialFolderLocation(hWnd, lngCSIdl, lngIDL) = 0 Then
With bi
.hwndOwner = hWnd
.pidlRoot = lngIDL
.strDisplayName = Space$(MAX_PATH)
.strTitle = strTitle
.ulFlags = lngBifFlags
End With
lngIDL = SHBrowseForFolder(bi)
If lngIDL <> 0 Then
strFolder = Space(MAX_PATH)
If CBool(SHGetPathFromIDList(lngIDL, strFolder)) Then
strFolder = TrimNull(strFolder)
lngReturn = 0&
Else
strFolder = TrimNull(bi.strDisplayName)
lngReturn = 0&
End If
Else
lngReturn = 1208&
End If
Call GlobalFree(lngIDL)
Else
lngReturn = 1208&
End If
BrowseForFolder = lngReturn
End Function

Private Function TrimNull(ByVal strValue As String) As String
Dim intPos As Integer
intPos = InStr(strValue, vbNullChar)
Select Case intPos
Case Is > 1
TrimNull = Left$(strValue, intPos - 1)
Case 0
TrimNull = strValue
Case 1
TrimNull = ""
End Select
End Function

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

Patrick <nospams_fredin@magic.fr> a écrit :

Bonjour,

J'utilise dans le code VB la boite de dialogue Windows pour
sélectionner un répertoire. Mais je voudrais aussi pouvoir
sélectionner un répertoire qui est sur le réseau en sélectionnant son
chemin complet. Mais apparemment la boite de dialogue ne permet pas
de le faire. Savez-vous pourquoi ?

Merci pour votre aide.

Vous avez filtré cet utilisateur ! Consultez son message

Salut,

Essaye avec la méthode ShowNetworkFolder() de ce module :

Option Explicit
Public Enum OFN_Constants
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_DONTADDTORECENT = &H2000000
OFN_ENABLEHOOK = &H20
OFN_ENABLEINCLUDENOTIFY = &H400000
OFN_ENABLESIZING = &H800000
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EX_NOPLACESBAR = &H1
OFN_EXPLORER = &H80000
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_FORCESHOWHIDDEN = &H10000000
OFN_HIDEREADONLY = &H4
OFN_LONGNAMES = &H200000
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHARENOWARN = 1
OFN_SHAREWARN = 0
OFN_SHOWHELP = &H10
OFN_USEMONIKERS = &H1000000
End Enum

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
strDisplayName As String
strTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Const CSIDL_NETWORK = &H12
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_BROWSEFORCOMPUTER = &H1000
Const MAX_PATH = 260

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 GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA"
(pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal
hwndOwner As Long, ByVal Folder As Long, ByRef IDL As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As
Long
Dim CustomColors() As Byte
Public Function OpenFileDialog(Optional DialogTitle As String, Optional
sFilter As String, Optional flags As OFN_Constants, Optional InitialDir As
String, Optional hwndOwner As Long) As String
Dim OFName As OPENFILENAME
With OFName
.lStructSize = Len(OFName)
.hwndOwner = hwndOwner
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = InitialDir
.lpstrTitle = DialogTitle
.flags = flags
End With
If GetOpenFileName(OFName) Then
OpenFileDialog = Trim$(OFName.lpstrFile)
If Asc(Right$(OpenFileDialog, 1)) = 0 Then OpenFileDialog Left$(OpenFileDialog, Len(OpenFileDialog) - 1)
Else
OpenFileDialog = ""
End If
End Function
Public Function ShowSave(Optional DialogTitle As String, Optional sFilter As
String, Optional flags As OFN_Constants, Optional InitialDir As String,
Optional hwndOwner As Long) As String
Dim OFName As OPENFILENAME
With OFName
.lStructSize = Len(OFName)
.hwndOwner = hwndOwner
.hInstance = App.hInstance
.lpstrFilter = sFilter
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = InitialDir
.lpstrTitle = DialogTitle
.flags = flags
End With
If GetSaveFileName(OFName) Then
ShowSave = Trim$(OFName.lpstrFile)
If Asc(Right$(ShowSave, 1)) = 0 Then ShowSave = Left$(ShowSave,
Len(ShowSave) - 1)
Else
ShowSave = ""
End If
End Function

Public Function ShowColor(hWndForm As Long) As Long
Dim cc As CHOOSECOLOR
With cc
.lStructSize = Len(cc)
.hwndOwner = hWndForm
.hInstance = App.hInstance
.lpCustColors = StrConv(CustomColors, vbUnicode)
.flags = 0
End With
If CHOOSECOLOR(cc) <> 0 Then
ShowColor = cc.rgbResult
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
Else
ShowColor = -1
End If
End Function

Public Sub InitCommonControlsAndDialogs()
Call InitCommonControls
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
Dim i As Integer
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
End Sub

Public Function ShowFolder(FormhWnd As Long, sTitre As String) As String
Dim sChe As String
Call BrowseForFolder(0, BIF_RETURNONLYFSDIRS, sChe, sTitre, FormhWnd)
If Right$(sChe, 1) <> "" Then sChe = sChe & ""
ShowFolder = sChe
End Function
Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As String) As
String
Dim sChe As String
Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER, sChe, sTitre,
FormhWnd)
ShowNetworkFolder = sChe
End Function
Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal lngBifFlags
As Long, ByRef strFolder As String, Optional ByVal strTitle As String "Select Folder", Optional ByVal hWnd As Long = 0) As Long
Dim bi As BROWSEINFO
Dim lngReturn As Long
Dim lngIDL As Long
If SHGetSpecialFolderLocation(hWnd, lngCSIdl, lngIDL) = 0 Then
With bi
.hwndOwner = hWnd
.pidlRoot = lngIDL
.strDisplayName = Space$(MAX_PATH)
.strTitle = strTitle
.ulFlags = lngBifFlags
End With
lngIDL = SHBrowseForFolder(bi)
If lngIDL <> 0 Then
strFolder = Space(MAX_PATH)
If CBool(SHGetPathFromIDList(lngIDL, strFolder)) Then
strFolder = TrimNull(strFolder)
lngReturn = 0&
Else
strFolder = TrimNull(bi.strDisplayName)
lngReturn = 0&
End If
Else
lngReturn = 1208&
End If
Call GlobalFree(lngIDL)
Else
lngReturn = 1208&
End If
BrowseForFolder = lngReturn
End Function

Private Function TrimNull(ByVal strValue As String) As String
Dim intPos As Integer
intPos = InStr(strValue, vbNullChar)
Select Case intPos
Case Is > 1
TrimNull = Left$(strValue, intPos - 1)
Case 0
TrimNull = strValue
Case 1
TrimNull = ""
End Select
End Function

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

Patrick a écrit :

Bonjour,

J'utilise dans le code VB la boite de dialogue Windows pour
sélectionner un répertoire. Mais je voudrais aussi pouvoir
sélectionner un répertoire qui est sur le réseau en sélectionnant son
chemin complet. Mais apparemment la boite de dialogue ne permet pas
de le faire. Savez-vous pourquoi ?

Merci pour votre aide.

François Picalausa

10/08/2004 à 21:44

Hello,

Je ne pense pas que BIF_BROWSEFORCOMPUTER soit approprié:
Only return computers. If the user selects anything other than a computer,
the OK button is grayed.

Aussi, GlobalFree n'est peut-être pas la solution pour décharger le PIDL.
Comme indiqué sur
http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/functions/shgetmalloc.asp :
This interface (IMalloc) *must* be used to free memory that was *allocated
by the Shell*

La description de cette interface en odl compatible VB peut être trouvée
dans ce post:
http://groups.google.com/groups?selm=OgehJTheEHA.2388%40TK2MSFTNGP10.phx.gbl
C'est AMHA plus propre...

--
François Picalausa (MVP VB)
http://faq.vb.free.fr --- http://msdn.microsoft.com
http://apisvb.europe.webmatrixhosting.net

"ng" a écrit dans le message de
news:%

Salut,

Const CSIDL_NETWORK = &H12
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_BROWSEFORCOMPUTER = &H1000
Const MAX_PATH = 260
...
Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As String)
As String
Dim sChe As String
Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER, sChe,
sTitre, FormhWnd)
ShowNetworkFolder = sChe
End Function
Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal
lngBifFlags As Long, ByRef strFolder As String, Optional ByVal
strTitle As String = "Select Folder", Optional ByVal hWnd As Long > 0) As Long Dim bi As BROWSEINFO
...
Call GlobalFree(lngIDL)
End Function

ng

10/08/2004 à 22:36

Salut,

Ah oui en effet j'avais fait ca pr moi (pour SimpleComm sous 98 pour
parcourir les PC du réseau :) ^^)...

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

François Picalausa a écrit :

Hello,

Je ne pense pas que BIF_BROWSEFORCOMPUTER soit approprié:
Only return computers. If the user selects anything other than a
computer,
the OK button is grayed.

Aussi, GlobalFree n'est peut-être pas la solution pour décharger le
PIDL.
Comme indiqué sur

http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/functions/shgetmalloc.asp

: This interface (IMalloc) *must* be used to free memory that was
*allocated
by the Shell*

La description de cette interface en odl compatible VB peut être
trouvée
dans ce post:

http://groups.google.com/groups?selm=OgehJTheEHA.2388%40TK2MSFTNGP10.phx.gbl

C'est AMHA plus propre...

"ng" a écrit dans le message de
news:%
Salut,

Const CSIDL_NETWORK = &H12
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_BROWSEFORCOMPUTER = &H1000
Const MAX_PATH = 260
...
Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As String)
As String
Dim sChe As String
Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER, sChe,
sTitre, FormhWnd)
ShowNetworkFolder = sChe
End Function
Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal
lngBifFlags As Long, ByRef strFolder As String, Optional ByVal
strTitle As String = "Select Folder", Optional ByVal hWnd As Long >> 0) As Long Dim bi As BROWSEINFO
...
Call GlobalFree(lngIDL)
End Function

lou

10/08/2004 à 22:53

attention! ng françois est incollable

"ng" a écrit dans le message de news:

Salut,

Ah oui en effet j'avais fait ca pr moi (pour SimpleComm sous 98 pour
parcourir les PC du réseau :) ^^)...

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

François Picalausa a écrit :

> Hello,
>
> Je ne pense pas que BIF_BROWSEFORCOMPUTER soit approprié:
> Only return computers. If the user selects anything other than a
> computer,
> the OK button is grayed.
>
> Aussi, GlobalFree n'est peut-être pas la solution pour décharger le
> PIDL.
> Comme indiqué sur
>

http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/fun
ctions/shgetmalloc.asp

> : This interface (IMalloc) *must* be used to free memory that was
> *allocated
> by the Shell*
>
> La description de cette interface en odl compatible VB peut être
> trouvée
> dans ce post:
>

http://groups.google.com/groups?selm=OgehJTheEHA.2388%40TK2MSFTNGP10.phx.gbl

> C'est AMHA plus propre...
>
>
> "ng" a écrit dans le message de
> news:%
>> Salut,
>>
>> Const CSIDL_NETWORK = &H12
>> Const BIF_RETURNONLYFSDIRS = 1
>> Const BIF_BROWSEFORCOMPUTER = &H1000
>> Const MAX_PATH = 260
>> ...
>> Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As String)
>> As String
>> Dim sChe As String
>> Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER, sChe,
>> sTitre, FormhWnd)
>> ShowNetworkFolder = sChe
>> End Function
>> Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal
>> lngBifFlags As Long, ByRef strFolder As String, Optional ByVal
>> strTitle As String = "Select Folder", Optional ByVal hWnd As Long > >> 0) As Long Dim bi As BROWSEINFO
>> ...
>> Call GlobalFree(lngIDL)
>> End Function

attention! ng françois est incollable

"ng" <ng@ngsoft-fr.com> a écrit dans le message de news:
e93Z0gxfEHA.556@tk2msftngp13.phx.gbl...

Salut,

Ah oui en effet j'avais fait ca pr moi (pour SimpleComm sous 98 pour
parcourir les PC du réseau :) ^^)...

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

François Picalausa <fpicalausa@chez.com> a écrit :

> Hello,
>
> Je ne pense pas que BIF_BROWSEFORCOMPUTER soit approprié:
> Only return computers. If the user selects anything other than a
> computer,
> the OK button is grayed.
>
> Aussi, GlobalFree n'est peut-être pas la solution pour décharger le
> PIDL.
> Comme indiqué sur
>

http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/fun
ctions/shgetmalloc.asp

> : This interface (IMalloc) *must* be used to free memory that was
> *allocated
> by the Shell*
>
> La description de cette interface en odl compatible VB peut être
> trouvée
> dans ce post:
>

http://groups.google.com/groups?selm=OgehJTheEHA.2388%40TK2MSFTNGP10.phx.gbl

> C'est AMHA plus propre...
>
>
> "ng" <ng@ngsoft-fr.com> a écrit dans le message de
> news:%23PIiFCxfEHA.1356@TK2MSFTNGP09.phx.gbl
>> Salut,
>>
>> Const CSIDL_NETWORK = &H12
>> Const BIF_RETURNONLYFSDIRS = 1
>> Const BIF_BROWSEFORCOMPUTER = &H1000
>> Const MAX_PATH = 260
>> ...
>> Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As String)
>> As String
>> Dim sChe As String
>> Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER, sChe,
>> sTitre, FormhWnd)
>> ShowNetworkFolder = sChe
>> End Function
>> Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal
>> lngBifFlags As Long, ByRef strFolder As String, Optional ByVal
>> strTitle As String = "Select Folder", Optional ByVal hWnd As Long > >> 0) As Long Dim bi As BROWSEINFO
>> ...
>> Call GlobalFree(lngIDL)
>> End Function

ng

10/08/2004 à 23:28

Je sais bien ;)

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

lou a écrit :

attention! ng françois est incollable

"ng" a écrit dans le message de news:

Salut,

Ah oui en effet j'avais fait ca pr moi (pour SimpleComm sous 98 pour
parcourir les PC du réseau :) ^^)...

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

François Picalausa a écrit :

Hello,

Je ne pense pas que BIF_BROWSEFORCOMPUTER soit approprié:
Only return computers. If the user selects anything other than a
computer,
the OK button is grayed.

Aussi, GlobalFree n'est peut-être pas la solution pour décharger le
PIDL.
Comme indiqué sur

http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/fun

ctions/shgetmalloc.asp
This interface (IMalloc) *must* be used to free memory that was

*allocated
by the Shell*

La description de cette interface en odl compatible VB peut être
trouvée
dans ce post:

http://groups.google.com/groups?selm=OgehJTheEHA.2388%40TK2MSFTNGP10.phx.gbl

C'est AMHA plus propre...

"ng" a écrit dans le message de
news:%
Salut,

Const CSIDL_NETWORK = &H12
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_BROWSEFORCOMPUTER = &H1000
Const MAX_PATH = 260
...
Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As
String) As String
Dim sChe As String
Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER,
sChe, sTitre, FormhWnd)
ShowNetworkFolder = sChe
End Function
Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal
lngBifFlags As Long, ByRef strFolder As String, Optional ByVal
strTitle As String = "Select Folder", Optional ByVal hWnd As Long >>>> 0) As Long Dim bi As BROWSEINFO
...
Call GlobalFree(lngIDL)
End Function

Je sais bien ;)

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

lou <colluluigi2@hotmail.com> a écrit :

attention! ng françois est incollable

"ng" <ng@ngsoft-fr.com> a écrit dans le message de news:
e93Z0gxfEHA.556@tk2msftngp13.phx.gbl...

Salut,

Ah oui en effet j'avais fait ca pr moi (pour SimpleComm sous 98 pour
parcourir les PC du réseau :) ^^)...

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
http://apisvb.europe.webmatrixhosting.net/

François Picalausa <fpicalausa@chez.com> a écrit :

Hello,

Je ne pense pas que BIF_BROWSEFORCOMPUTER soit approprié:
Only return computers. If the user selects anything other than a
computer,
the OK button is grayed.

Aussi, GlobalFree n'est peut-être pas la solution pour décharger le
PIDL.
Comme indiqué sur

http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/fun

ctions/shgetmalloc.asp

This interface (IMalloc) *must* be used to free memory that was

*allocated
by the Shell*

La description de cette interface en odl compatible VB peut être
trouvée
dans ce post:

http://groups.google.com/groups?selm=OgehJTheEHA.2388%40TK2MSFTNGP10.phx.gbl

C'est AMHA plus propre...

"ng" <ng@ngsoft-fr.com> a écrit dans le message de
news:%23PIiFCxfEHA.1356@TK2MSFTNGP09.phx.gbl

Salut,

Const CSIDL_NETWORK = &H12
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_BROWSEFORCOMPUTER = &H1000
Const MAX_PATH = 260
...
Public Function ShowNetworkFolder(FormhWnd As Long, sTitre As
String) As String
Dim sChe As String
Call BrowseForFolder(CSIDL_NETWORK, BIF_BROWSEFORCOMPUTER,
sChe, sTitre, FormhWnd)
ShowNetworkFolder = sChe
End Function
Private Function BrowseForFolder(ByVal lngCSIdl As Long, ByVal
lngBifFlags As Long, ByRef strFolder As String, Optional ByVal
strTitle As String = "Select Folder", Optional ByVal hWnd As Long >>>> 0) As Long Dim bi As BROWSEINFO
...
Call GlobalFree(lngIDL)
End Function

Séselectiom un répertoire sur le réseau

6 réponses

Veuillez sélectionner un problème