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 Long
Private 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 = -1
Private Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End 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 * 14
End 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,否则返回 False
Public 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 If
End Function
)
