楼主
xmyjk |
Q:由于VBA是单线程的，无法用API函数FINDWINDOW去获取其窗体中WEBBROWSER控件中网页的弹出ALERT的窗口。如果模拟创造另一个线程，去获取这个弹出窗口的文本值呢？
A:运用计时器TIMER来模拟创造另一个线程来解决，
注意：
如上图，我的IE的弹出警告窗的标题栏是Windows Internet Explorer（一般为Windows Internet Explorer;来自网页的消息;安全警报;安全警告等等），请按情况修改下面的代码“hWnd = FindWindowEx(0&, 0&, vbNullString, ByVal "Windows Internet Explorer")这句和FindWindowEx(0&, hMessageBox, vbNullString, ByVal "Windows Internet Explorer")这句”。
代码如下：
窗体代码：- Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
- Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
- Option Explicit
- Public a&
- Private Sub UserForm_Activate()
- WebBrowser1.Navigate2 ThisWorkbook.Path & "\1111.html"
- a = SetTimer(0, 0, 100, AddressOf CloseMessageTimerProc)
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
- KillTimer 0, a
- End Sub
标准模块代码：- Option Explicit
- Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As Any) As Long
- Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
- Public flag As Boolean
- Sub ttt()
- flag = False
- UserForm1.Show
- End Sub
- Sub CloseMessageTimerProc()
- Dim hMessageBox As Long
- Debug.Print flag
- If flag Then Exit Sub
- flag = True
- hMessageBox = FindWindowEx(0&, 0&, vbNullString, ByVal "Windows Internet Explorer")
- Do While hMessageBox
- ClickMessageBox hMessageBox
- hMessageBox = FindWindowEx(0&, hMessageBox, vbNullString, ByVal "Windows Internet Explorer")
- Loop
- End Sub
- Private Sub ClickMessageBox(ByVal phwnd As Long)
- Dim wndtext As String, AllWndText As String, i As Long, fhwnd As Long
- wndtext = Space(512)
- fhwnd = phwnd
- phwnd = FindWindowEx(fhwnd, 0&, vbNullString, 0&)
- Do While phwnd > 0
- i = GetWindowText(phwnd, wndtext, 512)
- If i Then AllWndText = AllWndText & Left(wndtext, i) & "-"
- phwnd = FindWindowEx(fhwnd, phwnd, vbNullString, 0&)
- Loop
- [a1] = Replace(AllWndText, Chr(0), "")
- SendKeys "~"
- End Sub
 webbrowser2线程.zip
|