vb打开文件夹对话框,并可事先指定默认路径,打开指定目录的对话框
2008-10-30 10:43
691 查看
点击收藏
可以用SHBrowseForFolder来实现
'Objects: Form1、Command1、Module1
'Form1:
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private 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 lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Const LPTR = (&H0 Or &H40)
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
Private Function MyAddressOf(AddressOfX As Long) As Long
MyAddressOf = AddressOfX
End Function
Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
Dim Ret As Long
szTitle = "This is the title"
Dim sPath As String
sPath = VBA.InputBox("初始路径:", , "C:/program files")
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
.lpfnCallback = MyAddressOf(AddressOf BrowseForFolders_CallbackProc)
Ret = LocalAlloc(LPTR, VBA.Len(sPath) + 1)
CopyMemory ByVal Ret, ByVal sPath, VBA.Len(sPath) + 1
.lParam = Ret
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = VBA.Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = VBA.Left(sBuffer, VBA.InStr(sBuffer, vbNullChar) - 1)
MsgBox sBuffer
End If
End Sub
'Module1:
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const BFFM_INITIALIZED As Long = 1
Public Function BrowseForFolders_CallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
If uMsg = BFFM_INITIALIZED Then
SendMessage hWnd, BFFM_SETSELECTIONA, True, ByVal lpData
End If
End Function
可以用SHBrowseForFolder来实现
'Objects: Form1、Command1、Module1
'Form1:
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private 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 lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Const LPTR = (&H0 Or &H40)
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
Private Function MyAddressOf(AddressOfX As Long) As Long
MyAddressOf = AddressOfX
End Function
Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
Dim Ret As Long
szTitle = "This is the title"
Dim sPath As String
sPath = VBA.InputBox("初始路径:", , "C:/program files")
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
.lpfnCallback = MyAddressOf(AddressOf BrowseForFolders_CallbackProc)
Ret = LocalAlloc(LPTR, VBA.Len(sPath) + 1)
CopyMemory ByVal Ret, ByVal sPath, VBA.Len(sPath) + 1
.lParam = Ret
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = VBA.Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = VBA.Left(sBuffer, VBA.InStr(sBuffer, vbNullChar) - 1)
MsgBox sBuffer
End If
End Sub
'Module1:
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const BFFM_INITIALIZED As Long = 1
Public Function BrowseForFolders_CallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
If uMsg = BFFM_INITIALIZED Then
SendMessage hWnd, BFFM_SETSELECTIONA, True, ByVal lpData
End If
End Function
相关文章推荐
- C# Visual Studio 2005中让打开对话框打开指定的文件夹
- MFC Win32程序打开选择目录对话框并获得绝对路径
- C#项目打开/保存文件夹/指定类型文件,获取路径
- Qt-编程模块 001: 浏览(选择)、打开 文件和文件夹(目录) --- 如何让按钮**记忆上次打开的文本路径**的功能
- C# 打开以对话框,获取文件夹路径 、文件的路径、文件名
- Silverlight 5 RC新特性:11.SaveFileDialog保存指定默认名称-OpenFileDialog打开指定默认路径
- EXCEL-VBA:调用打开文件夹对话框,选择路径
- 如何快速在命令提示符(cmd)中打开指定的文件夹路径!
- VC新建目录CreateDirectory、得到exe存放路径GetModuleFileName、获取当前目录GetCurrentDirectory、CFileDialog设置打开默认路径
- xcode如何用代码打开指定的文件夹目录并显示目录内容
- c#winform选择文件,文件夹,打开指定目录方法
- C#中调用资源管理器(Explorer.exe)打开指定文件夹 + 并选中指定文件 + 调用(系统默认的播放类)软件(如WMP)打开(播放歌曲等)文件
- Android 拷贝assets目录下所有文件及文件夹到指定路径
- 修改JFileChooser对话框风格,设置打开对话框的默认文件名,获取改变路径之后的文件保存路径
- C#打开指定路径的文件夹
- c#winform选择文件,文件夹,打开指定目录方法
- 打开选择文件对话框时指定初始选择路径
- C# 打开指定的文件夹 记住路径中 / 与 \ 的用法
- 【Window OS】Win 7 修改资源管理器打开后的默认路径为计算机目录
- VB如何执行命令 打开资源管理器 并选择指定的文件夹或文件