如何在VB中跳出的一个对话框里选择盘符?

[wanyuanwanyuan]

如何在VB中跳出的一个对话框里选择盘符？而且是只有选择盘符，不能选择盘符下的文件夹

[迈克揉索芙特]

用vb自带的DriveListBox做一个吧

[tztz520]

只要能找出系统的所有盘符跟类型,你想怎么发挥都行了.

先引用 Microsoft Scripting Runtime library，方法如下：

【工程】-->选择【引用】-->选择【Microsoft Scripting Runtime】(Scrrun.dll)

Dim FSO As FileSystemObject
Dim aDrive As Drive
Set FSO = New FileSystemObject
For Each aDrive In FSO.Drives
Debug.Print "盘符:" & aDrive.DriveLetter & " " & "类型:" & aDrive.DriveType
Next
Set FSO = Nothing

[ZOU_SEAFARER]

在工程里面添加一个Dialog 窗体
然后在Dialog窗体里面增加Drive1
Form1 窗体代码
Option Explicit

Private Sub Command1_Click()
Dialog.Show
Me.Hide

End Sub


dialog窗体代码
Option Explicit
Public x As Variant
Private Sub OKButton_Click()
x = Me.Drive1.Drive
Me.Hide
Form1.Show
Form1.Print x
End Sub

[wanyuanwanyuan]

Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Function usefolder() As String
Dim bi As BROWSEINFO '声明必要的变量
Dim t As Long
Dim rtn&, pidl&, path$, pos%
Dim specin As String
Dim specout As String
bi.hOwner = Me.hWnd '使对话框处于屏幕中心
bi.lpszTitle = "选择目录..." '设置标题文字
bi.ulFlags = 1 '返回文件夹的类型
pidl& = SHBrowseForFolder(bi) '显示对话框
path = Space(512) '设置字符数的最大值
t = SHGetPathFromIDList(ByVal pidl&, ByVal path) '获得所选的路径
pos% = InStr(path$, Chr$(0)) '从字符串中提取路径
specin = Left(path$, pos - 1)
If Right$(specin, 1) = "\" Then
specout = specin
Else
specout = specin + "\"
End If
usefolder = specout
End Function
Private Sub Command1_Click()
'取得注册表中路径
bdval = RegReadStringValue("HKEY_LOCAL_MACHINE", "SoftWare\WXSK\SKHY", "UsbDisk", usbdisk)
'判断数据盘符是否存在
If judgedrive(Left(usbdisk, 2)) = False Then
MsgBox "请选择正确的闪盘盘符!", 64, "信息提示"
Dim strpath As String
strpath = usefolder()
If Len(Trim(strpath)) < 2 Then Exit Sub
strpath = Left(strpath, 2)
If Right(strpath, 1) <> "\" Then
strpath = strpath & "\"
End If
bdval = RegSetStringValue("HKEY_LOCAL_MACHINE", "SoftWare\WXSK\SKHY", "UsbDisk", strpath & "skdata\")
bdval = RegReadStringValue("HKEY_LOCAL_MACHINE", "SoftWare\WXSK\SKHY", "UsbDisk", usbdisk)
End If
end sub