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,否则返回 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) If lngRet = 0 Then OpenFolderAndSetFileFocus = True End If Call SHFree(lngPidl) End IfEnd Function