VBA 如何确定网页中弹出的对话框

南宫煌sea

EH各位老师好，我用VBA写了将Excel数据填写到网页表单上，但是提交的时候会弹出来自网页信息的窗口，需要按确定才能继续下一步。我在EH上查找了弹出来自网页信息的窗口的相关帖，用蓝天老师写的代码单独可以运行，但是放到提交代码后，却不能按确定窗口，liucqa老师说这是VBA单线程的原因造成的，需要用API处理，请问EH各位老师有没有一些例子提供给我参考一下，或者有没有其他的处理方法呢？
附上写的代码：

1. 
   
2. 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
   
3. Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
   
4. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
5. Private Const WM_LBUTTONDOWN = &H201
   
6. Private Const WM_LBUTTONUP = &H202
   
7. Private Const MK_LBUTTON = &H1
   
8. 
   
9. Sub Execl填写网页表单()
   
10.    Dim mShellwindows As New ShellWindows, ie As InternetExplorer
    
11.     For Each ie In mShellwindows
    
12.         If ie.LocationURL Like "http://10.3.18.72/enq/inqueryAction.do?reqCode=inqRegBegin&enqSort=INQ_DOM&inoutFlag=OUT&enqClass=1&srcTab=1*" Then Exit For
    
13.     Next
    
14.     With ie.Document
    
15.          .all("itemno").Value = Cells(2, 1)
    
16.          .all("collTime").Value = Cells(2, 2)
    
17.          .all("collDstAlphaid").Focus
    
18.          .all("collDstAlphaid").Value = Cells(2, 3)
    
19.          t1 = Timer
    
20.          Do Until Timer > t1 + 3 '需要时间触发网页上的onblur函数
    
21.          Loop
    
22.         .all("senderName").Value = Cells(2, 4)
    
23.         .all("senderPhone").Value = Cells(2, 5)
    
24.         .all("senderAddr").Value = Cells(2, 6)
    
25.         .all("recverName").Value = Cells(2, 7)
    
26.         .all("recverPhone").Value = Cells(2, 8)
    
27.         .all("recverAddr").Value = Cells(2, 9)
    
28.         .all("explain").Focus
    
29.         .all("explain").Value = Cells(2, 10)
    
30.          Do Until Timer > t1 + 5 '等待关联菜单显示内容
    
31.          Loop
    
32.          .all("btnSend").Click  'click之后会弹出一个确定的对话框，之前试过submit Form，不过这里不行
    
33.     End With
    
34.    
    
35.     winHwnd = FindWindow(vbNullString, "来自网页的消息")              '这段代码是在EH上看到蓝天老师写的，单独运行可以，放在这里运行不行
    
36.     If winHwnd <> 0 Then
    
37.         btnHwnd = FindWindowEx(winHwnd, 0, "Button", "确定")
    
38.         SendMessage btnHwnd, WM_LBUTTONDOWN, 0, ByVal 0
    
39.         SendMessage btnHwnd, WM_LBUTTONUP, 0, ByVal 0
    
40.         SendMessage btnHwnd, WM_LBUTTONDOWN, 0, ByVal 0
    
41.         SendMessage btnHwnd, WM_LBUTTONUP, 0, ByVal 0
    
42.     End If
    
43.    
    
44.     Do While ie.Busy
    
45.         DoEvents
    
46.     Loop
    
47.    
    
48.    
    
49. End Sub

复制代码

wudixin96

用API 的话，你可以间隔时间FINDWINDOW一下，FIND到就点击

也就是settimer，然后KillTimer

liucqa

这种网页尽量用xmlhttp或者winhttp

南宫煌sea

wudixin96 发表于 2014-6-3 13:35
用API 的话，你可以间隔时间FINDWINDOW一下，FIND到就点击

也就是settimer，然后KillTimer

wudixin96老师，请问有没有具体的应用实例？

wudixin96

1. Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
2. Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
   
3. Private id_timer As Long
   
4. Sub Execl填写网页表单()
   
5.    Dim mShellwindows As New ShellWindows, ie As InternetExplorer
   
6.    id_timer = SetTimer(0, 0, 500, AddressOf TimeProc)
   
7.     For Each ie In mShellwindows
   
8.         If ie.LocationURL Like "http://10.3.18.72/enq/inqueryAction.do?reqCode=inqRegBegin&enqSort=INQ_DOM&inoutFlag=OUT&enqClass=1&srcTab=1*" Then Exit For
   
9.     Next
   
10.     With ie.Document
    
11.          .all("itemno").Value = Cells(2, 1)
    
12.          .all("collTime").Value = Cells(2, 2)
    
13.          .all("collDstAlphaid").Focus
    
14.          .all("collDstAlphaid").Value = Cells(2, 3)
    
15.          t1 = Timer
    
16.          Do Until Timer > t1 + 3 '需要时间触发网页上的onblur函数
    
17.          Loop
    
18.         .all("senderName").Value = Cells(2, 4)
    
19.         .all("senderPhone").Value = Cells(2, 5)
    
20.         .all("senderAddr").Value = Cells(2, 6)
    
21.         .all("recverName").Value = Cells(2, 7)
    
22.         .all("recverPhone").Value = Cells(2, 8)
    
23.         .all("recverAddr").Value = Cells(2, 9)
    
24.         .all("explain").Focus
    
25.         .all("explain").Value = Cells(2, 10)
    
26.          Do Until Timer > t1 + 5 '等待关联菜单显示内容
    
27.          Loop
    
28.          .all("btnSend").Click  'click之后会弹出一个确定的对话框，之前试过submit Form，不过这里不行
    
29.     End With
    
30.    
    
31.    
    
32.    
    
33.     Do While ie.Busy
    
34.         DoEvents
    
35.     Loop
    
36. End Sub
    
37. 
    
38. Sub TimeProc()
    
39.     winHwnd = FindWindow(vbNullString, "来自网页的消息")              '这段代码是在EH上看到蓝天老师写的，单独运行可以，放在这里运行不行
    
40.     If winHwnd <> 0 Then
    
41.         btnHwnd = FindWindowEx(winHwnd, 0, "Button", "确定")
    
42.         SendMessage btnHwnd, WM_LBUTTONDOWN, 0, ByVal 0
    
43.         SendMessage btnHwnd, WM_LBUTTONUP, 0, ByVal 0
    
44.         SendMessage btnHwnd, WM_LBUTTONDOWN, 0, ByVal 0
    
45.         SendMessage btnHwnd, WM_LBUTTONUP, 0, ByVal 0
    
46.         KillTimer 0, id_timer
    
47.     End If
    
48. End Sub
    

复制代码

没测试过哦，你试试看

南宫煌sea

wudixin96 发表于 2014-6-3 16:21
没测试过哦，你试试看

直接用代码click不行，然后手动click，会自动按确认。
还有一个问题想问一下，现在我等待时间是怎么写的，请问还有其他办法吗？

1. 
   
2. Do Until Timer > t1 + 3  '需要时间差触发网页上的onblur函数
   
3.             'DoEvents  不注释有时候会报溢出的错。
   
4. Loop
   

复制代码

wudixin96

南宫煌sea 发表于 2014-6-3 18:46
直接用代码click不行，然后手动click，会自动按确认。
还有一个问题想问一下，现在我等待时间是怎么写的 ...

你又不给帐号密码，我没法调试，只是说怎么用SETTIMER，至于原代码的问题，你得自己解决

等待时间，用API SLEEP试试

南宫煌sea

wudixin96 发表于 2014-6-4 07:06
你又不给帐号密码，我没法调试，只是说怎么用SETTIMER，至于原代码的问题，你得自己解决

等待时间，用 ...

因为要内网上，所以给了账号和密码也登录不了。我在  If winHwnd <> 0 Then  后面 添加了  Cells(2, 11) = 1 来调试能否捕获窗口，结果发现自动click捕获不了，但是在第一次操作弹出的窗口之后，后面其他弹出的窗口都能够捕获。

1. Sub TimeProc()
   
2.     winHwnd = FindWindow(vbNullString, "来自网页的消息")              '这段代码是在EH上看到蓝天老师写的，单独运行可以，放在这里运行不行
   
3.     If winHwnd <> 0 Then
   
4.         Cells(2, 11) = 1 ' 调试能否捕获窗口
   
5.         btnHwnd = FindWindowEx(winHwnd, 0, "Button", "确定")
   
6.         SendMessage btnHwnd, WM_LBUTTONDOWN, 0, ByVal 0
   
7.         SendMessage btnHwnd, WM_LBUTTONUP, 0, ByVal 0
   
8.         'SendMessage btnHwnd, WM_LBUTTONDOWN, 0, ByVal 0
   
9.         'SendMessage btnHwnd, WM_LBUTTONUP, 0, ByVal 0
   
10.         'KillTimer 0, id_timer
    
11.     End If
    
12. End Sub
    

复制代码

szroy

同样的问题求解。

VBA万岁

关注中......