加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

VB6调用API打开目标文件所在文件夹且选中目标文件

发布时间:2020-12-16 23:05:48 所属栏目:大数据 来源:网络整理
导读:Option Explicit ' 模块名称: mOpenFolderAndSetFileFocus ' 作者: 唐细刚 ' 时间: 2010-08-22 ' 功能: VB6调用API打开目标文件所在文件夹且选中目标文件 ' 注: ' 由于调用 Explorer.exe /select 方式会使系统产生多余的 Explorer.exe 进程 ' 所以还是API来

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

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读