楼主
kevinchengcw |
Q: 如何利用vba激活已打开的本工作簿所在文件夹窗口或未打开时打开所在文件夹?
A: 代码如下:- '定义常量
- Private Const GW_HWNDNEXT = 2
- Private Const GW_HWNDFIRST = 0
- Private Const WM_GETTEXT = &HD
- '定义要引用的API函数
- Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal Hwnd As Long, ByVal wFlag As Long) As Long
- Private Declare Function GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
- Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
- Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
- Private Declare Function SetForegroundWindow Lib "user32" (ByVal Hwnd As Long) As Long
- Private Declare Function FindWindow Lib "user32 " Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
- Sub test()
- Dim Hwnd&, Str$
- If ThisWorkbook.Path <> "" Then '如果当前工作簿已保存到具体位置,则
- Hwnd = FindWindow("XLMAIN", vbNullString) '查找Excel程序窗口
- Hwnd = GetWindow(Hwnd, GW_HWNDFIRST) '查找同级窗口中的第一个程序窗口的句柄
- While Hwnd <> 0 '当句柄有效时循环
- Str = String(256, Chr(0)) '设置256字符的字符串变量
- GetClassName Hwnd, Str, 255 '提取该句柄对应的类名到变量
- Str = Replace(S, Chr(0), "") '替换到无效的字符
- If Str = "CabinetWClass" And GetUrl(Hwnd) = ThisWorkbook.Path Then '如果浏览器窗口且浏览位置是本工作簿所在文件夹,则
- SetForegroundWindow Hwnd '将窗口激活置顶
- Exit Sub '取出程序
- End If
- Hwnd = GetNextWindow(Hwnd, GW_HWNDNEXT) '继续取下一个窗口的句柄
- Wend
- Shell "explorer.exe """ & ThisWorkbook.Path & """",, vbMaximizedFocus '如果未能找到已打开的窗口则新打开一个
- Else
- MsgBox "文件还未保存!"
- End If
- End Sub
- Function GetUrl(Hwnd As Long) As String '获取窗口对应地址自定义函数
- Dim NexthWnd&, Str$
- NexthWnd = 0 '初始化句柄为0(即无效)
- NexthWnd = FindWindowEx(Hwnd, NexthWnd, vbNullString, vbNullString) '获取传入的窗口句柄的子窗口句柄
- While NexthWnd <> 0 '找到的句柄有效时执行循环
- Str = String(256, Chr(0)) '设置256字符的字符串变量
- GetClassName NexthWnd, Str, 255 '获取对应窗体控件的类名
- Str = Replace(S, Chr(0), "") '替换掉无意义字符
- If Str = "Edit" Then '如果是文本框,则
- Str = String(256, Chr(0)) '设置256字符的字符串变量
- SendMessage NexthWnd, WM_GETTEXT, 255, Str '获取窗口文本
- Str = Replace(S, Chr(0), "") '替换掉无意义字符
- GetUrl = Str '返回得到的文本
- If Len(Str) > 0 Then Exit Function '如果得到的是非空字符串则退出函数
- Else '否则
- GetUrl = GetUrl(NexthWnd) '调取下一窗体地址
- If Len(GetUrl) > 0 Then Exit Function '如果得到的是非空字符串则退出函数
- End If
- NexthWnd = FindWindowEx(Hwnd, NexthWnd, vbNullString, vbNullString) '循环到下一窗体
- Wend
- End Function
附示例文件.
 Demo.rar
|