早上好,我正在努力寻找有关问题的信息,该问题似乎在Internet上没有太多信息 - 这是Internet Explorer中的"框架通知栏"询问您是否要"保存"或"打开"下载的文件(的窗口。
我将削减追逐,我遇到的问题是,当Internet Explorer可见性设置为True时,我的代码可以工作,但是当可见性设置为false时不起作用。在两种情况下,我都介入了代码,以查看什么变化,并注意到框架通知条更改值的句柄,但除此之外,所有这些都相同。相关代码是:
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
从此代码中,我认为问题发生的片段在:
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
任何人都可以向我提供为什么可能会发生这种情况以及如何修复它的想法?我知道我已经在问很多,但是我真的很喜欢任何解决方案的解释,因为我试图提高理解,并发现在类似情况下它将对他人有益:)
谢谢。
请看以下示例:
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*?);[sS]*?$", 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
注意。网站自动检测到过多的验证令牌请求,可能会导致该帐户被阻止,在这种情况下,您需要输入验证码并确认您的电话号码以通过SMS接收代码。这就是为什么检索一旦检索到环境变量以进行进一步使用的原因。