VB 浏览文件夹获取文件夹路径

commondialog控件只能选择文件，不能选择文件夹，用下春野面的洞物代码可以选文件夹：

Option Explicit

Private Type BrowseInfo

hWndOwner As Long

pIDLRoot As Long

pszDisplayName As Long

lpszTitle As Long

ulFlags As Long

lpfnCallback As Long

lParam As Long

iImage As Long

End Type

Const BIF_RETURNONLYFSDIRS = 1

Const MAX_PATH = 260

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

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

Public Function BrowseForFolder(Optional sTitle As String = "请选择文件夹") As String

Dim iNull As Integer, lpIDList As Long, lResult As Long

Dim sPath As String, udtBI As BrowseInfo

With udtBI

.hWndOwner = 0 ' Me.hWnd

.lpszTitle = lstrcat(sTitle, "")

.ulFlags = BIF_RETURNONLYFSDIRS

End With

lpIDList = SHBrowseForFolder(udtBI)

If lpIDList Then

sPath = String$(MAX_PATH, 0)

SHGetPathFromIDList lpIDList, sPath

CoTaskMemFree lpIDList

iNull = InStr(sPath, vbNullChar)

If iNull Then

sPath = Left$(sPath, iNull - 1)

End If

End If

BrowseForFolder = sPath

End Function

Private Sub Command1_Click()

MsgBox BrowseForFolder()

End Sub

Dim a() As String

Private Sub Dir1_Change()

File1.Path = Dir1.Path

Label1.Caption = Dir1.Path

End Sub

Private Sub Drive1_Change()

On Error GoTo err1

Dir1.Path = Drive1.Drive

Exit Sub

err1:

MsgBox Err.Description, vbInformation + vbOKOnly, "提示"

End Sub

Private Sub Command1_Click()

Dim i As Integer, j As Integer

Dim ifieldcount As Integer, irecordcount As Integer

Dim wdapp As Word.Application

Dim wddoc As Word.Document

Dim atable As Word.Table

If Option2.Value = True Then

ReDim a(1 To File1.ListCount)

For i = 1 To File1.ListCount

b = File1.List(i)

a(i) = b

Next

End If

If Option1.Value = True Then

ReDim a(1 To Dir1.ListCount)

For i = 1 To Dir1.ListCount

b = Dir1.List(i)

a(i) = b

Next

End If

End Sub

这段程序 复制过去 就行了 创建的控件有 两个option 让你选择 要提取文件夹 还是文件歼好路径的 选中option 1 就是提取文件夹的 option2 就是提取文件的 然后再创建 Drive1 Dir1 File1 这三个亮改消 选择文件路径的 控件 再加一个 command 按钮 就行了 有疑问再联系我！！！！敬知！这个 只是 文件路径 你看看 是你想要的话 我再给你写 提取文件夹和文件名的代码！！！！

---