Option Explicit
' 模块名称: mOpenFolderAndSetFileFocus' 作者: 唐细刚' 时间: 2010-08-22' 功能: VB6调用API打开目标文件所在文件夹且选中目标文件' 注：' 由于调用 Explorer.exe /select 方式会使系统产生多余的 Explorer.exe 进程' 所以还是API来实现较好，速度也有优势，不知道是否低碳? O(∩_∩)O~
Private Declare Function SHCreateFromPath Lib "Shell32" Alias "ILCreateFromPathA" (ByVal lpFileName As String) As LongPrivate Declare Sub SHFree Lib "Shell32" Alias "ILFree" (ByVal lngPidl As Long)Private Declare Function SHOpenFolderAndSelectItems Lib "Shell32" ( _ ByVal pidlFolder As Long, _ ByVal cidl As Long, _ ByVal apidl As Long, _ ByVal dwFlags As Long) As Long
'增加判断文件是否存在Private Const INVALID_HANDLE_VALUE = -1Private Const MAX_PATH = 260
Private Type FILETIME dwLowDateTime As Long dwHighDateTime As LongEnd Type
Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _ ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Function FileExists(ByVal lpFileName As String) As Boolean Dim tpWFD As WIN32_FIND_DATA Dim lngFile As Long lngFile = FindFirstFile(lpFileName, tpWFD) FileExists = lngFile <> INVALID_HANDLE_VALUE If lngFile Then Call FindClose(lngFile)End Function
'调用成功返回 True,否则返回 FalsePublic Function OpenFolderAndSetFileFocus(ByVal lpFileName As String) As Boolean On Error Resume Next Dim lngPidl As Long Dim lngRet As Long Dim strFile As String strFile = Trim(lpFileName) If FileExists(strFile) = False Then Exit Function lngPidl = SHCreateFromPath(strFile & vbNullChar) If lngPidl <> 0 Then lngRet = SHOpenFolderAndSelectItems(lngPidl, 0, 0, 0) If lngRet = 0 Then OpenFolderAndSetFileFocus = True End If Call SHFree(lngPidl) End IfEnd Function
转载于:https://www.cnblogs.com/forads/archive/2010/08/22/2161111.html
