VBA di Excel per rispondere al prompt di download di Internet Explorer 11, in Windows 10?

Sto cercando di automatizzare il download di file .csv da http://www.nasdaqomxnordic.com utilizzando Excel 2010 VBA e Internet Explorer.

  1. Come automatizzare la risposta al prompt del download con Salva?

  2. Prima di arrivare alla parte download il codice VBA deve fare clic su un pulsante con questo codice html web:

Visa historik

Sto usando questo codice VBA:

 Set anchorElement = Document.getElementsByClassName("button showHistory floatRight").Item(Index:=1) anchorElement.Click 

Funziona quando passo il codice ma quando lo anchorElement.Click viene visualizzato un messaggio di errore sulla riga anchorElement.Click :

La variabile object o la variabile con blocco non viene specificata.

Qualche suggerimento su 1 o 2?

Considera il download di dati storici per le condivisioni tramite XMLHttpRequest anziché l’automazione di IE. Nell’esempio seguente viene specificato ISIN condivisa (SE0001493776 per AAK), prima richiesta restituisce ID condivisione (SSE36273) e la seconda richiesta recupera i dati storici da id, quindi la mostra nel blocco note come testo e salva come file csv.

 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 Sub Function 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 end End Function Function 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 Function Function 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 With End Function Function 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 If End Function Function 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:""", 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 Loop End Function Function 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=" For Each sParam In oParams sPayload = sPayload & "" Next sPayload = sPayload & "" 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 With End Function Function LZ(sValue, nDigits) LZ = Right(String(nDigits, "0") & CStr(sValue), nDigits) End Function Function ConvDate(d) ConvDate = Year(d) & "-" & LZ(Month(d), 2) & "-" & LZ(Day(d), 2) End Function Function BytesToText(aBytes, sCharSet) With CreateObject("ADODB.Stream") .Type = 1 ' adTypeBinary .Open .Write aBytes .Position = 0 .Type = 2 ' adTypeText .Charset = sCharSet BytesToText = .ReadText .Close End With End Function Sub SaveBytesToFile(aBytes, sPath) With CreateObject("ADODB.Stream") .Type = 1 ' adTypeBinary .Open .Write aBytes .SaveToFile sPath, 2 ' adSaveCreateOverWrite .Close End With End Sub Sub 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 With End Sub 

AGGIORNARE

Si noti che l’approccio di cui sopra rende il sistema vulnerabile in alcuni casi, dal momento che consente l’accesso diretto alle unità (e altre cose) per il codice JS dannoso tramite ActiveX. Supponiamo che tu stia analizzando la risposta del server web JSON, come JsonString = "{a:(function(){(new ActiveXObject('Scripting.FileSystemObject')).CreateTextFile('C:\\Test.txt')})()}" . Dopo averlo valutato, troverai il nuovo file C:\Test.txt . Quindi l’analisi di JSON con ScriptControl ActiveX non è una buona idea. Controlla l’ aggiornamento della mia risposta per il parser JSON basato su RegEx.