一応動きます程度のサンプルとしてUPしておきます。
不要な宣言とか、無駄もありますが、その辺はご勘弁。

（こんなものでも、すぐ動くサンプルは殆どなさそうなので）
初期フォルダの指定、選択したフォルダ名の表示をするようにしてます。
本気で使う時は、きっちり作りこんで下さい。

本当はC#のサンプル
http://support.microsoft.com/kb/306285/ja
をVBで書き直すのがよさそうです。

なお、これはやばいぞってな所があれば、お教え頂ければ幸いです。

Imports System.Runtime.InteropServices



Public Class  BrowseForFolder

#Region "API宣言"

    Private Const BFFM_INITIALIZED As Integer = 1

    Private Const BFFM_SELCHANGED As Integer = 2

    Private Const BFFM_VALIDATEFAILED As Integer = 3



    Private Const WM_USER As Integer = &H400

    Private Const BFFM_SETSTATUSTEXTA As Integer = (WM_USER + 100)

    Private Const BFFM_ENABLEOK As Integer = (WM_USER + 101)

    Private Const BFFM_SETSELECTION As Integer = (WM_USER + 102)



    Private Const MAX_PATH As Integer = 260



    Private BIF_EDITBOX = &H10                  'ダイアログボックス内にアイテム名入力用のテキストボックスを追加する 

    Private BIF_NEWDIALOGSTYLE = &H40



    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _

    Private Structure BROWSEINFO

        Public hWndOwner As IntPtr

        Public pidlRoot As Integer

        Public pszDisplayName As IntPtr

        <MarshalAs(UnmanagedType.LPTStr)> _

        Public lpszTitle As String

        Public ulFlags As Integer

        <MarshalAs(UnmanagedType.FunctionPtr)> _

        Public lpfn As BrowseCallbackProc

        Public lParam As IntPtr

        Public iImage As Integer

    End Structure





    Private Declare Auto Function SHBrowseForFolder Lib "shell32.dll" _

                                (ByRef bi As BROWSEINFO) As IntPtr



    Private Declare Auto Function SHGetPathFromIDList Lib "shell32.dll" _

                    (ByVal pidl As IntPtr, ByVal pszPath As String) As Integer



    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _

                    (ByVal hWnd As IntPtr, _

                     ByVal wMsg As Integer, _

                     ByVal wParam As Integer, _

                     ByVal lParam As Integer) As Integer



    'Auto修飾子を付けたらSendMessageが失敗する（Alias "SendMessageA"がなくても失敗する。理由はわからない） 

    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _

                    (ByVal hWnd As IntPtr, _

                     ByVal wMsg As Integer, _

                     ByVal wParam As Integer, _

                     ByVal lParam As String) As Integer



    'SHGetPathFromIDListで取得したItemIDListを開放する 

    Private Declare Function CoTaskMemFree Lib "ole32.dll" (ByVal pv As Integer) As Integer



#End Region





#Region "Class宣言"

    Private Delegate Function BrowseCallbackProc(ByVal hwnd As IntPtr, ByVal uMsg As Integer, _

                            ByVal lParam As IntPtr, ByVal lpData As IntPtr) As Integer

    'ﾌﾟﾛﾊﾟﾃｨ保管用 

    Private m_BInfo As BROWSEINFO



    Private m_Owner As IntPtr           '親ウィンドウのHWND 

    Private m_InitDirectory As String   '初期表示ﾌｫﾙﾀﾞを指定する際に使用 

    Private m_Description As String      'STATUSTEXT 

    Private m_TitleBarText As String    'ﾀｲﾄﾙﾊﾞｰﾃｷｽﾄ 

    Private m_ShowEditBox As Boolean    'EditBoxの表示指定 



#End Region