本文介绍了Excel VBA回答Internet Explorer 11下载提示,在Windows 10中?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧! 问题描述 我正在尝试使用Excel从 http://www.nasdaqomxnordic.com 自动下载.csv文件2010 VBA和Internet Explorer。 如何使用保存自动回复下载提示? 在我下载部分之前,VBA代码需要点击这个网页HTML代码的按钮: < div class =button showHistory floatRight> Visa historik< / div> 我正在使用这个VBA代码: 设置anchorElement = Document.getElementsByClassName(button showHistory floatRight)。Item(Index:= 1) anchorElement.Click / pre> 当我执行代码时,这可以工作,但是当我运行它时,我会收到一条错误消息在 anchorElement.Click 未指定对象变量或With-block变量。 任何有关1或2的建议?解决方案 XMLHttpRequest而不是IE自动化。在下面的示例中,共享ISIN被指定(用于AAK的SE0001493776),第一个请求返回共享ID(SSE36273),第二个请求通过id检索历史数据,然后在记事本中显示为文本,并保存为csv文件。 Sub Test() Dim dToDate,dFromDate,aDataBinary,sShareISIN,sShareId dToDate = Date'当天 dFromDate = DateAdd(yyyy,-1,dToDate)一年前 sShareISIN =SE0001493776'为AAK sShareId = GetId(sShareISIN)'SSE36273 aDataBinary = GetHistoryData (sShareId,dFromDate,dToDate) ShowInNotepad BytesToText(aDataBinary,us-ascii) SaveBytesToFile aDataBinary,C:\Test\HistoricData& sShareId& .csv End Sub 函数GetId(sName) Dim oJson 使用CreateObject(MSXML2.XMLHTTP)。打开GET ,http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx?SubSystem=Prices&Action=Search&InstrumentISIN=& EncodeUriComponent(sName)& & json = 1,False .Send 设置oJson = GetJsonDict(.ResponseText)结束 GetId = oJson(inst)(@ id ) CreateObjectx86,True'关闭mshta主机窗口结束函数 函数EncodeUriComponent(strText)静态objHtmlfile作为对象如果objHtmlfile是设置objHtmlfile = CreateObject(htmlfile) objHtmlfile.parentWindow.execScript函数encode(s){return encodeURIComponent(s)},jscript End If EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)结束函数 函数GetJsonDict(JsonString)使用CreateObjectx86(ScriptControl)'通过x86 mshta主机创建ActiveX,对于64位办公兼容性 .Language =JScript .ExecuteStatement函数gettype(sample){return {} .toString.call(sample).slice(8,-1)} .ExecuteStatement函数evaljson(json,er){t ry {var sample = eval('('+ json +')'); var type = gettype(sample); if(type!='Array'&& type!='Object'){return er;} else {return getdict(sample);}} catch(e){return er;}}。 ExecuteStatement函数getdict(sample){var type = gettype(sample); if(type!='Array'&& type!='Object')返回样本; var dict = new ActiveXObject('Scripting.Dictionary'); if(type =='Array'){for(var key = 0; key< sample.length; key ++){dict.add(key,getdict(sample [key]));}} else {for(var key在样本中){dict.add(key,getdict(sample [key]));}} return dict;}设置GetJsonDict = .Run(evaljson,JsonString,Nothing)结束With 结束函数 函数CreateObjectx86(可选sProgID,可选bClos​​e = False) 静态oWnd As Object Dim bRunning As Boolean #If Win64然后 bRunning = InStr(TypeName(oWnd),HTMLWindow)> 0 如果bClos​​e Then 如果bRunning Then oWnd.Close 退出函数 End If 如果不是bRunning然后设置oWnd = CreateWindow() oWnd.execScript函数CreateObjectx86(sProgID):设置CreateObjectx86 = CreateObject(sProgID):结束函数, VBScript End If 设置CreateObjectx86 = oWnd.CreateObjectx86(sProgID) #Else 如果不是bClos​​e然后设置CreateObjectx86 = CreateObject(sProgID) #End如果 结束函数 函数CreateWindow() 'source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356 Dim sSignature,oShellWnd,oProc On Error Resume Next sSignature = Left (CreateObject(Scriptlet.TypeLib)。GUID,38) CreateObject(WScript.Shell)。运行%systemroot%\syswow64\mshta.exe关于:< head>脚本> moveTo(-32000,-32000); document.title ='x86Host'< / script>< hta:application showintaskbar = no />< object id ='shell'classid ='clsid:8856F961-340A -11D0-A96B-00C04FD705A2'>< param name = RegisterAsBrowser value = 1>< / object>< script> shell.putproperty('& sSignature& ,document.parentWindow);< / script>< / head>,0,False 为为每个oShellWnd在CreateObject(Shell.Application)Windows 设置CreateWindow = oShellWnd.GetProperty(sSignature)如果Err.Number = 0然后退出函数 Err.Clear 下一个循环 结束函数 函数GetHistoryData(sId,dFromDate,dToDate) Dim oParams,sPayload,sParam 设置oParams = CreateObject(Scripting.Dictionary) oParams( (Action)=GetDataSeries oParams(AppendIntraDay)=否 oParams(Instrument)= sId oParams(FromDate)= ConvDate(dFromDate) oParams(ToDate)= ConvDate(dToDate) oParams(hi__a )=0,5,6,3,1,2,4,21,8,10,12,9,11 oParams(ext_xslt)=/nordicV3/hi_csv.xsl oParams(OmitNoTrade)=true oParams(e oParams(ext_xslt_options)=,, oParams(ext_contenttype)=application / ms-excel oParams(ext_xslt_hiddenattrs) =,iv,ip, sPayload =xmlquery =< post> 对于每个sParam在oParams sPayload = sPayload& < param name =& sParam& value =& oParams(sParam)& /> 中下一个 sPayload = sPayload& < /后> 中使用CreateObject(MSXML2.XMLHTTP)。打开POST,http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx,False .SetRequestHeader内容-Type,application / x-www-form-urlencoded; charset = UTF-8 .Send sPayload GetHistoryData = .ResponseBody End with End Function 函数LZ(sValue,nDigits) LZ = Right(String(nDigits,0)& CStr(sValue),nDigits)结束函数 函数ConvDate(d) ConvDate = Year(d)& - & LZ(月(d),2)& - & LZ(Day(d),2)结束函数 函数BytesToText(aBytes,sCharSet)使用CreateObject(ADODB.Stream) .Type = 1'adTypeBinary .Open 。写aBytes .Position = 0 .Type = 2'adTypeText .Charset = sCharSet BytesToText = .ReadText .Close 结束结束函数 Sub SaveBytesToFile(aBytes,sPath)使用CreateObject(ADODB.Stream) .Type = 1'adTypeBinary .Open 。写aBytes .SaveToFile sPath,2'adSaveCreateOverWrite .Close 结束 End Sub Sub ShowInNotepad(sContent) Dim sTmpPath 使用CreateObject(Scripting.FileSystemObject) sTmpPath = CreateObject(WScript.Shell)。ExpandEnvironmentStrings(%TEMP %)& \& .GetTempName 带.CreateTextFile(sTmpPath,True,True) .WriteLine(sContent) .Close 结束 CreateObject(WScript.Shell)。运行notepad.exe& sTmpPath,1,True .DeleteFile(sTmpPath)结束 End Sub 更新 请注意,上述方法在某些情况下使系统易受攻击,因为它允许直接访问驱动器(和其他东西)通过ActiveX的恶意JS代码。让我们假设您正在解析Web服务器响应JSON,如 JsonString ={a:(function(){(new ActiveXObject('Scripting.FileSystemObject'))。CreateTextFile('C:\\Test .TXT')})()}。评估后,您会发现新创建的文件 C:\Test.txt 。所以JSON解析与 ScriptControl ActiveX不是一个好主意。检查基于RegEx的JSON解析器的更新我的答案。 I am trying to automate downloading of .csv files from http://www.nasdaqomxnordic.com using Excel 2010 VBA and Internet Explorer. How to automate answering the download prompt with Save?Before I get to the download part the VBA code needs to click on a button with this web html code:<div class="button showHistory floatRight">Visa historik</div>I am using this VBA code: Set anchorElement = Document.getElementsByClassName("button showHistory floatRight").Item(Index:=1)anchorElement.ClickThis works when I step through the code but when I run it I get an error message on the line anchorElement.Click: Object variable or With-block variable is not specified.Any suggestions on 1 or 2? 解决方案 Consider downloading historic data for shares via XMLHttpRequest instead of IE automation. In the example below share ISIN is specified (SE0001493776 for AAK), first request returns share id (SSE36273), and second request retrieves historic data by id, then shows it in notepad as text, and saves as csv file.Sub Test() Dim dToDate, dFromDate, aDataBinary, sShareISIN, sShareId dToDate = Date ' current day dFromDate = DateAdd("yyyy", -1, dToDate) ' one year ago sShareISIN = "SE0001493776" ' for AAK sShareId = GetId(sShareISIN) ' SSE36273 aDataBinary = GetHistoryData(sShareId, dFromDate, dToDate) ShowInNotepad BytesToText(aDataBinary, "us-ascii") SaveBytesToFile aDataBinary, "C:\Test\HistoricData" & sShareId & ".csv"End SubFunction GetId(sName) Dim oJson With CreateObject("MSXML2.XMLHTTP") .Open "GET", "http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx?SubSystem=Prices&Action=Search&InstrumentISIN=" & EncodeUriComponent(sName) & "&json=1", False .Send Set oJson = GetJsonDict(.ResponseText) End With GetId = oJson("inst")("@id") CreateObjectx86 , True ' close mshta host window at the endEnd FunctionFunction EncodeUriComponent(strText) 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(strText)End FunctionFunction GetJsonDict(JsonString) With CreateObjectx86("ScriptControl") ' create ActiveX via x86 mshta host, for 64-bit office compatibility .Language = "JScript" .ExecuteStatement "function gettype(sample) {return {}.toString.call(sample).slice(8, -1)}" .ExecuteStatement "function evaljson(json, er) {try {var sample = eval('(' + json + ')'); var type = gettype(sample); if(type != 'Array' && type != 'Object') {return er;} else {return getdict(sample);}} catch(e) {return er;}}" .ExecuteStatement "function getdict(sample) {var type = gettype(sample); if(type != 'Array' && type != 'Object') return sample; var dict = new ActiveXObject('Scripting.Dictionary'); if(type == 'Array') {for(var key = 0; key < sample.length; key++) {dict.add(key, getdict(sample[key]));}} else {for(var key in sample) {dict.add(key, getdict(sample[key]));}} return dict;}" Set GetJsonDict = .Run("evaljson", JsonString, Nothing) End WithEnd FunctionFunction CreateObjectx86(Optional sProgID, Optional bClose = False) Static oWnd As Object Dim bRunning As Boolean #If Win64 Then bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0 If bClose Then If bRunning Then oWnd.Close Exit Function End If If Not bRunning Then Set oWnd = CreateWindow() oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript" End If Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID) #Else If Not bClose Then Set CreateObjectx86 = CreateObject(sProgID) #End IfEnd FunctionFunction CreateWindow() ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356 Dim sSignature, oShellWnd, oProc On Error Resume Next sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38) CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe ""about:<head><script>moveTo(-32000,-32000);document.title='x86Host'</script><hta:application showintaskbar=no /><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""", 0, False Do For Each oShellWnd In CreateObject("Shell.Application").Windows Set CreateWindow = oShellWnd.GetProperty(sSignature) If Err.Number = 0 Then Exit Function Err.Clear Next LoopEnd FunctionFunction GetHistoryData(sId, dFromDate, dToDate) Dim oParams, sPayload, sParam Set oParams = CreateObject("Scripting.Dictionary") oParams("Exchange") = "NMF" oParams("SubSystem") = "History" oParams("Action") = "GetDataSeries" oParams("AppendIntraDay") = "no" oParams("Instrument") = sId oParams("FromDate") = ConvDate(dFromDate) oParams("ToDate") = ConvDate(dToDate) oParams("hi__a") = "0,5,6,3,1,2,4,21,8,10,12,9,11" oParams("ext_xslt") = "/nordicV3/hi_csv.xsl" oParams("OmitNoTrade") = "true" oParams("ext_xslt_lang") = "en" oParams("ext_xslt_options") = ",," oParams("ext_contenttype") = "application/ms-excel" oParams("ext_xslt_hiddenattrs") = ",iv,ip," sPayload = "xmlquery=<post>" For Each sParam In oParams sPayload = sPayload & "<param name=""" & sParam & """ value=""" & oParams(sParam) & """/>" Next sPayload = sPayload & "</post>" With CreateObject("MSXML2.XMLHTTP") .Open "POST", "http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx", False .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8" .Send sPayload GetHistoryData = .ResponseBody End WithEnd FunctionFunction LZ(sValue, nDigits) LZ = Right(String(nDigits, "0") & CStr(sValue), nDigits)End FunctionFunction ConvDate(d) ConvDate = Year(d) & "-" & LZ(Month(d), 2) & "-" & LZ(Day(d), 2)End FunctionFunction BytesToText(aBytes, sCharSet) With CreateObject("ADODB.Stream") .Type = 1 ' adTypeBinary .Open .Write aBytes .Position = 0 .Type = 2 ' adTypeText .Charset = sCharSet BytesToText = .ReadText .Close End WithEnd FunctionSub SaveBytesToFile(aBytes, sPath) With CreateObject("ADODB.Stream") .Type = 1 ' adTypeBinary .Open .Write aBytes .SaveToFile sPath, 2 ' adSaveCreateOverWrite .Close End WithEnd SubSub ShowInNotepad(sContent) Dim sTmpPath With CreateObject("Scripting.FileSystemObject") sTmpPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%TEMP%") & "\" & .GetTempName With .CreateTextFile(sTmpPath, True, True) .WriteLine (sContent) .Close End With CreateObject("WScript.Shell").Run "notepad.exe " & sTmpPath, 1, True .DeleteFile (sTmpPath) End WithEnd SubUPDATENote that the above approach makes the system vulnerable in some cases, since it allows the direct access to the drives (and other stuff) for the malicious JS code via ActiveX's. Let's suppose you are parsing web server response JSON, like JsonString = "{a:(function(){(new ActiveXObject('Scripting.FileSystemObject')).CreateTextFile('C:\\Test.txt')})()}". After evaluating it you'll find new created file C:\Test.txt. So JSON parsing with ScriptControl ActiveX is not a good idea. Check the update of my answer for the RegEx-based JSON parser. 这篇关于Excel VBA回答Internet Explorer 11下载提示,在Windows 10中?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!
10-26 18:16