[英]VBA Internet automation code not working when ie.Visible = False
Good morning, I am struggling to find information on a problem which seems to not have much information available on the internet - that is the "frame notification bar" in internet explorer ( the little yellow window that asks you if you want to "save" or "open" a file downloaded). 早上好,我正在努力寻找有关互联网上似乎没有太多信息的问题的信息 - 这是互联网资源管理器中的“框架通知栏”(小黄色窗口,询问您是否要“保存”或“打开”下载的文件)。
I will cut to the chase, the issue I am having is that my code works when an internet explorer visibility is set to true, but doesn't work when visibility is set to false. 我将切入追逐,我遇到的问题是我的代码在Internet Explorer可见性设置为true时有效,但在可见性设置为false时不起作用。 I have stepped through the code in both situations to see what changes, and noticed the handle for the frame notification bar changes value but other than that all are the same.
我已经在两种情况下逐步完成代码以查看更改,并注意到框架通知栏的句柄更改值,但除此之外所有都相同。 The relevant code is:
相关代码是:
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
Sub StartIE()
Dim appIE As Object
Dim URLString As String
Dim HTMLdoc, btn As Object
Set appIE = CreateObject("internetexplorer.application") ' create an instance of internet explorer
With appIE
.Navigate "https://analytics.twitter.com/user" 'this url wont work for you. you will need to have your own twitter account on twitter analytics, and copy the link to the "tweets" page
.Visible = True ' and show the IE
End With
Do While appIE.Busy Or (appIE.READYSTATE <> 4) ' wait until IE has finished loading
DoEvents
Loop
URLString = appIE.LocationURL
Set HTMLdoc = appIE.document
Set btn = HTMLdoc.getElementsByClassName("btn btn-default ladda-button")(0) 'finds the export data button
btn.Click
Do While appIE.Busy Or (appIE.READYSTATE <> 4) ' wait until IE has finished loading
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:07"))
Dim hwnd As LongPtr, h As LongPtr
Dim o As IUIAutomation ' The following steps are used to download a csv file from a webpage
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = appIE.hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString) ' we must find the first frame notification handle
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
h = appIE.hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd2 As IUIAutomationCondition
Set iCnd2 = o.CreatePropertyCondition(UIA_NamePropertyId, "Open") ' similar to the above snippet, except for the second stage of the frame notification window
Dim Button2 As IUIAutomationElement
Set Button2 = e.FindFirst(TreeScope_Subtree, iCnd2)
Dim InvokePattern2 As IUIAutomationInvokePattern
Set InvokePattern2 = Button2.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern2.Invoke
End Sub
Out of this code, the snippet where I believe the issue is occurring is in: 在这段代码中,我认为问题发生的片段在:
Dim o As IUIAutomation ' The following steps are used to download a csv file from a webpage
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = appIE.hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString) ' we must find the first frame notification handle
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
Can anyone provide me with an idea of why this might be happening, and how I might fix it? 任何人都可以让我知道为什么会发生这种情况,以及我如何解决这个问题? I know I'm asking alot already but I would really love an explanation alongside any fix as I am trying to improve my understanding, and find it will be beneficial to others in a similar situation :)
我知道我已经问了很多,但我真的很喜欢和任何解决方案一起解释,因为我正在努力提高我的理解力,并且发现它会对类似情况下的其他人有益:)
Thankyou in advance. 先感谢您。
Take a look at the below example: 看看下面的例子:
Option Explicit
Sub SaveTweetsToCsv()
Dim sAuthToken As String
Dim sUserName As String
Dim sStartTime As String
Dim sEndTime As String
Dim aHeaders
Dim sUrl As String
Dim sParams As String
Dim sResp As String
' Set init data
sUserName = "myusername" ' Your username
sStartTime = "1517184000000" ' UNIX time with milliseconds
sEndTime = "1519603199999"
' Check saved auth token
sAuthToken = GetEnvVar("user", "tw_auth_token")
' Retrieve auth token if missing
If sAuthToken = "" Then sAuthToken = GetAuthToken()
' Prepare request parameters
sUrl = "https://analytics.twitter.com/user/" & sUserName & "/tweets/"
sParams = "start_time=" & sStartTime & "&end_time=" & sEndTime & "&lang=en"
' Set request auth token header
aHeaders = Array(Array("cookie", "auth_token=" & sAuthToken))
' Make request and check availability
Do
' Retrieve status
WinHTTPRequest "POST", sUrl & "export.json?" & sParams, _
"", _
aHeaders, _
"", _
"", _
sResp, _
""
' Check if auth token is invalid
If InStr(sResp, "403 Forbidden") > 0 Then sAuthToken = GetAuthToken()
' Check report availability
If InStr(sResp, """status"":""Available""") > 0 Then Exit Do
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
Loop
' Retrieve CSV content
WinHTTPRequest "GET", sUrl & "bundle?" & sParams, _
"", _
aHeaders, _
"", _
"", _
sResp, _
""
' Save CSV
WriteTextFile sResp, CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\result.csv", -1
MsgBox "Completed"
End Sub
Function GetAuthToken() As String
Dim sLogin As String
Dim sPassword As String
Dim sHdrs As String
Dim sResp As String
Dim aSetHeaders
Dim aTmp
Dim sToken As String
Dim aPayload
Dim sPayload As String
Dim aOptions
Dim i As Long
If MsgBox("Login", vbOKCancel) = vbCancel Then End
sLogin = "mylogin" ' Your login
sPassword = "mypassword" ' Your password
' Retrieve login form
WinHTTPRequest "GET", "https://twitter.com/", _
"", _
"", _
"", _
sHdrs, _
sResp, _
""
' Extract cookies from headers
ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sHdrs, aSetHeaders
' Extract authenticity_token from login form
aTmp = Split(sResp, """ name=""authenticity_token""", 2)
If UBound(aTmp) = 0 Then MsgBox "Failed to get authenticity token": End
sToken = Mid(aTmp(0), InStrRev(aTmp(0), """") + 1)
' Prepare payload for login request
aPayload = Array( _
Array("session[username_or_email]", sLogin), _
Array("session[password]", sPassword), _
Array("remember_me", "1"), _
Array("return_to_ssl", "true"), _
Array("scribe_log", ""), _
Array("redirect_after_login", "/"), _
Array("authenticity_token", sToken), _
Array("ui_metrics", "") _
)
For i = 0 To UBound(aPayload)
aPayload(i) = EncodeUriComponent((aPayload(i)(0))) & "=" & EncodeUriComponent((aPayload(i)(1)))
Next
sPayload = Join(aPayload, "&")
' Add web form headers
PushItem aSetHeaders, Array("Content-Type", "application/x-www-form-urlencoded")
PushItem aSetHeaders, Array("Content-Length", Len(sPayload))
' WinHTTP option disabling redirections
aOptions = Array(Array(6, False)) ' redirectoins disabled
' Login request
WinHTTPRequest "POST", "https://twitter.com/sessions", _
aOptions, _
aSetHeaders, _
sPayload, _
sHdrs, _
sResp, _
""
' Extract auth_token from received headers
aTmp = Split(sHdrs, "auth_token=", 2)
If UBound(aTmp) = 0 Then MsgBox "Failed to get auth token": End
GetAuthToken = Split(aTmp(1), ";", 2)(0)
' Save auth token to user env var for further usage
SetEnvVar "user", "tw_auth_token", GetAuthToken
MsgBox "Auth token retrieved successfully"
End Function
Sub SetEnvVar(sEnv As String, sName As String, sValue As String)
CreateObject("WSCript.Shell").Environment(sEnv).Item(sName) = sValue
End Sub
Function GetEnvVar(sEnv As String, sName As String) As String
GetEnvVar = CreateObject("WSCript.Shell").Environment(sEnv).Item(sName)
End Function
Sub WinHTTPRequest(sMethod, sUrl, aSetOptions, aSetHeaders, vFormData, sRespHeaders, sRespText, aRespBody)
Dim aItem
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open sMethod, sUrl, False
If IsArray(aSetOptions) Then
For Each aItem In aSetOptions
.Option(aItem(0)) = aItem(1)
Next
End If
If IsArray(aSetHeaders) Then
For Each aItem In aSetHeaders
.SetRequestHeader aItem(0), aItem(1)
Next
End If
.send (vFormData)
sRespHeaders = .GetAllResponseHeaders
sRespText = .ResponseText
aRespBody = .ResponseBody
End With
End Sub
Sub ParseResponse(sPattern, sResponse, aData, Optional bAppend As Boolean = True, Optional bGlobal As Boolean = True, Optional bMultiLine As Boolean = True, Optional bIgnoreCase As Boolean = True)
Dim oMatch
Dim aTmp()
Dim sSubMatch
If Not (IsArray(aData) And bAppend) Then aData = Array()
With CreateObject("VBScript.RegExp")
.Global = bGlobal
.MultiLine = bMultiLine
.IgnoreCase = bIgnoreCase
.Pattern = sPattern
For Each oMatch In .Execute(sResponse)
If oMatch.SubMatches.Count = 1 Then
PushItem aData, oMatch.SubMatches(0)
Else
aTmp = Array()
For Each sSubMatch In oMatch.SubMatches
PushItem aTmp, sSubMatch
Next
PushItem aData, aTmp
End If
Next
End With
End Sub
Sub PushItem(aData, vItem, Optional bAppend As Boolean = True)
If Not (IsArray(aData) And bAppend) Then aData = Array()
ReDim Preserve aData(UBound(aData) + 1)
aData(UBound(aData)) = vItem
End Sub
Function EncodeUriComponent(sText As String) As String
Static objHtmlfile As Object
If objHtmlfile Is Nothing Then
Set objHtmlfile = CreateObject("htmlfile")
objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
End If
EncodeUriComponent = objHtmlfile.parentWindow.encode(sText)
End Function
Sub WriteTextFile(sContent As String, sPath As String, lFormat As Long)
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 2, True, lFormat)
.Write sContent
.Close
End With
End Sub
Note. 注意。 Excessive auth token requests are detected by the web site as automated, that may lead to the account to be blocked, in that case you will need to enter the captcha and confirm your phone number to receive a code by SMS.
网站检测到过多的身份验证令牌请求是自动的,这可能导致帐户被阻止,在这种情况下,您需要输入验证码并确认您的电话号码以通过短信接收代码。 That is why auth token is saved to environment variable once it is retrieved, for further usage.
这就是auth令牌一旦被检索就保存到环境变量的原因,以供进一步使用。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.