新建一个窗体,添加一个textbox 和一个button,拷贝下面的代码。
Imports System.Text
Imports System.Runtime.InteropServices
Public Class OpenFolder_OK
Private Delegate Function fbCallBack(ByVal hWnd As Integer, ByVal uMsg As Integer, ByVal lParam As Integer, ByVal lpData As Integer) As Integer
Private initpath As String = "C:/"
Private Structure BROWSEINFO
Dim hOwner As Integer
Dim pidlRoot As Integer
Dim pszDisplayName As String
Dim lpszTitle As String
Dim ulFlags As Integer
Dim lpfn As fbCallBack
Dim lParam As Integer
Dim iImage As Integer
End Structure
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (ByVal lpBrowseInfo As IntPtr) As Integer
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Integer, ByVal pszPath As StringBuilder) As Integer
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Const WM_USER As Integer = &H400
Private Const BFFM_INITIALIZED As Integer = 1
Private Const BFFM_SELCHANGED As Integer = 2
'Private Const BIF_BROWSEINCLUDEFILES As Integer = &H4000
Private Const BIF_DONTGOBELOWDOMAIN As Integer = &H2
Private Const BFFM_SETSELECTIONA As Integer = (WM_USER + 102)
Private Const BFFM_SETSTATUSTEXT As Integer = &H464
Private Const BIF_RETURNONLYFSDIRS As Integer = &H1
Dim pnt As IntPtr
Dim BIptr As IntPtr
Dim pIdl As Integer
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Try
pnt = Nothing
BIptr = Nothing
pIdl = Nothing
If Not My.Computer.FileSystem.DirectoryExists(initpath) Then
MsgBox(initpath & " not exist")
Exit Try
End If
Dim BI As BROWSEINFO
Dim sPath As StringBuilder
Dim txtPath As String
With BI
.hOwner = Me.Handle
.pszDisplayName = Space(260)
.lpszTitle = "Test"
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = AddressOf BrowseCallBackProc
.lParam = Marshal.StringToHGlobalAnsi(initpath)
End With
txtPath = ""
BIptr = Marshal.AllocHGlobal(Marshal.SizeOf(BI))
Marshal.StructureToPtr(BI, BIptr, False)
pIdl = SHBrowseForFolder(BIptr)
If pIdl = 0 Then Exit Try
sPath = New StringBuilder(255)
SHGetPathFromIDList(pIdl, sPath)
txtPath = sPath.ToString
TextBox1.Text = txtPath
initpath = txtPath
Marshal.FreeHGlobal(pIdl)
Catch ex As Exception
MsgBox(ex.ToString)
Finally
Marshal.FreeHGlobal(BIptr)
Marshal.FreeHGlobal(pnt)
End Try
End Sub
Public Function BrowseCallBackProc(ByVal hWnd As Integer, ByVal uMsg As Integer, ByVal lParam As Integer, ByVal lpData As Integer) As Integer
Try
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, &H1, lpData)
Case BFFM_SELCHANGED
SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, lpData)
End Select
Catch Ex As Exception
Throw Ex
End Try
End Function
End Class