Is there an easier / direct way to access localstorage variables from an Internet Explorer object except for executing JS to create the value on the DOM ?
I have my own custom solution utilizing a temporary textfield but I wonder if MS provides a direct function.
Function retrieveLocalStorageValue(sURL As String, sLocalStorageVarName As String) As String
On Error GoTo ErrHandler1:
Dim javascriptString As String
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
On Error GoTo ErrHandlerJscript:
javastringUrl = "document.body.innerHTML += '<input id=\""test1234\"" type=\""text\"" value=\""'+ localStorage.getItem('" & sLocalStorageVarName & "') +'\""\>';"
'Execute javascript to create hidden field - Use double quotes in VBA to escape
'Wait in case it is needed
Application.Wait DateAdd("s", 1, Now)
oBrowser.document.parentWindow.eval javastringUrl
retrieveLocalStorageValue = oBrowser.document.getElementById("test1234").getAttribute("value")
Exit Function
ErrHandler1:
MsgBox ("Error, debugging required")
retrieveLocalStorageValue = "error"
ErrHandlerJscript:
MsgBox ("Error with javascript execution, debugging required")
retrieveLocalStorageValue = "error"
End Function
Sub test()
Dim test As String
test = retrieveLocalStorageValue("http://127.0.0.1/stackexchange/localStorageVBA.html", "testObject")
MsgBox test
End Sub
Reference: http://maythesource.com/2014/04/22/vba-read-localstorage-variable-from-internet-explorer-object-using-temporary-textfield/
No not really. Yes, you can set a reference to Microsoft Internet Explorer and a reference to Microsoft HTML Object Library. This will allow you to access the DOM object model directly, and the intellisense will work. But if you actually try to access the property, it will throw an error. (As demonstrated below:)
Option Explicit
Sub Example()
ThisFails "http://www.w3schools.com/html/tryit.asp?filename=tryhtml5_webstorage_local", "lastname"
End Sub
Function ThisFails(ByVal sURL As String, ByVal sLocalStorageVarName As String) As String
Dim oBrowser As SHDocVw.InternetExplorer
Dim hDoc As MSHTML.HTMLDocument
Dim hWin As MSHTML.HTMLWindow2
Set oBrowser = New SHDocVw.InternetExplorer
oBrowser.Silent = True
oBrowser.Navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE
Do
Set hDoc = oBrowser.Document
'Trust me on these loops
Loop While hDoc Is Nothing
Do
Set hWin = hDoc.parentWindow
Loop While hWin Is Nothing
ThisFails = hWin.localStorage.getItem(sLocalStorageVarName)
End Function
Related
I am not sure if I am referencing the button correctly. I keep on getting:
Run-time error '438': Object doesn't support this property or method.
This is what my code looks like at the moment:
Sub russInd()
Dim oButton As Object, HTMLdoc As Object
Dim sht1 As Worksheet, myURL As String
Set ie = CreateObject("InternetExplorer.Application")
Set sht1 = Worksheets("Day 1")
myURL = sht1.Cells(32, 2).Value
ie.navigate myURL
ie.Visible = True
Do Until ie.ReadyState = 4
DoEvents
Loop
'Locate The correct forms and buttons
Set HTMLdoc = ie.document
Set oButton = HTMLdoc.querySelectorAll("a[href='javascript:submitForm(document.forms[0].action);']")
'Check All Checkboxes
HTMLdoc.getElementByID("chkAll").Click
oButton.Click
End Sub
The webpage I am using is:
https://indexcalculator.ftserussell.com/
Here is the webpage code:
I need to click the next button, I did try using
.getElementByID("CtlNavigation_lblControl")
To click the button, however that just skipped over the command, I guess it clicked nothing. Thanks!
querySelectorAll returns a nodelist. You likely want querySelector
Try
HTMLdoc.getElementById("CtlNavigation_lblControl").querySelector("a").Click
or
HTMLdoc.querySelector("CtlNavigation_lblControl a").Click
Set your selector to this: (It's saying look for any image in a parent A element.)
Set oButton = HTMLdoc.querySelectorAll("a > img")
Here is the full code with the modification:
Sub russInd()
Dim oButton As Object, HTMLdoc As Object
Dim sht1 As Worksheet, myURL As String
Set ie = CreateObject("InternetExplorer.Application")
Set sht1 = Worksheets("Day 1")
myURL = sht1.Cells(32, 2).Value
ie.navigate myURL
ie.Visible = True
Do Until ie.ReadyState = 4
DoEvents
Loop
'Locate The correct forms and buttons
Set HTMLdoc = ie.document
Set oButton = HTMLdoc.querySelectorAll("a > img")
'Check All Checkboxes
HTMLdoc.getElementByID("chkAll").Click
oButton.Click
End Sub
Use the following selector as it works across all steps. The number of child a elements within the parent with id Ctlnavigation2_lblControl changes so the following is a robust way to always get what you want across pages.
HTMLdoc.querySelector("#Ctlnavigation2_lblControl [href*=action]").Click
Your error, as partially correct in comments, is that you are trying to use a method of certain node types e.g. a tag element on a nodeList (which is what querySelectorAll returns). It does NOT return a collection. That is a very important distinction in VBA. If you try to For Each, as you would with a collection, over that nodeList Excel will crash.
I am trying to create IEautomation through vba-excel for the following link.
URL: http://qpldocs.dla.mil/search/default.aspx
The code includes search for the string "QPL-631",and click on the corresponding java script link MIL-I-631D(6).When I inspected "MIL-I-631D(6)" link ,I found following source code of href tag
MIL-I-631D(6)
So there are no click options for the href link and the address of manual clicking on href link is completely different than href address.So I am stuck here.I would like to add a code that clicks "MIL-I-631D(6)" and outputs the results.
I have tried the below code and so far and unable to proceed further.
Private Sub IE_Autiomation()
Dim i As Long
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Dim ae As HTMLLinkElement
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://qpldocs.dla.mil/search/default.aspx"
Application.StatusBar = "Loading. Please wait..."
Do While IE.Busy = True Or IE.readyState <> 4: DoEvents: Loop
Application.StatusBar = "Search form submission. Please wait..."
IE.document.getElementById("Search_panel1_tbox").Value = "QPL-631"
IE.document.getElementById("Search_panel1_btn").Click
Do While IE.Busy = True Or IE.readyState <> 4: DoEvents: Loop
Here is an interim solution to write out to sheet as you are already hard coding the product code "QPL-631" you can just skip straight to using that in the URL string to return your results.
Note: I have pulled the table ID from that page:
html.getElementById("Lu_gov_DG")
You might want to explore if this is a common theme across products (I suspect yes). Will make life a lot easier. You could even do away with IE altogether and go for a faster XHR solution.
Option Explicit
Private Sub IE_Automation()
'References Internet Controls and HTML Object library
Dim i As Long
Dim IE As Object
Dim html As HTMLDocument
Dim product As String
product = "QPL-631"
Dim url As String
url = "http://qpldocs.dla.mil/search/parts.aspx?qpl=1528¶m=" & product & "&type=256"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate url '"http://qpldocs.dla.mil/search/default.aspx"
Application.StatusBar = "Loading. Please wait..."
Do While .Busy = True Or .readyState <> 4: DoEvents: Loop
Set html = .Document
Dim allRowOfData As Object
Set allRowOfData = html.getElementById("Lu_gov_DG")
Dim r As Long, c As Long
Dim curHTMLRow As Object
For r = 1 To allRowOfData.Rows.Length - 1
Set curHTMLRow = allRowOfData.Rows(r)
For c = 0 To curHTMLRow.Cells.Length - 1
Cells(r + 1, c + 1) = curHTMLRow.Cells(c).innerText
Next c
Next r
.Quit
End With
Application.StatusBar = False 'And tidy up our change to the status bar
End Sub
There is example with postback here, which I will have a look at.
Reference:
How to reset the Application.StatusBar
You have several options available to you. See below for a pretty comprehensive list of possibilities.
Try getting the collection of anchor tags, with:
GetElementsByTagName("a")
Then, iterate that collection using as much logic as you can to ensure you're clicking the right button.
For each l in ie.document.getElementsByTagName("a")
If l.ClassName = "hqt_button" Then
l.Click
Exit For
Next
If there are multiple anchors with the same classname, you could do:
If l.ClassName = "hqt_button" AND l.Href = ""javascript:void(0): onclick=HeaderBox.trySubmit()" Then
l.Click
Exit For
Next
Alternatively
If you are using IE9+ you could use the GetElementsByClassName method.
GetElementsByClassName("hqt_button")
How do I use excel vba to click a link on a web page
okay so i am looking to scrap some dating from a web page and i cant seem to make it dynamic.
I need to lookup an element tag "th" that has a value of "level" and then grab the corresponding "td" element tag
This information is coming from an html table with a hiarchy of:
{table
-tbody
--tr
---th
---td
--tr
---th
---td}
here is the start of my code:
{
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = Range("link").Row And _
Target.Column = Range("link").Column Then
Dim ie As New InternetExplorer
ie.Visible = True
ie.navigate Range("link").Value
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Dim doc As HTMLDocument
Set doc = ie.document
Dim sTR As String
sTR = doc.getElementsByTagName("th")(5).textContent
MsgBox sTR
End If
End Sub
}
I get this far but I have found that the "th" dosnt match every webpage that i am looking for. sometimes "th" 5 dosnt have the same value that i need.
I am trying to use Excel VBA to copy the URL content in between the CData nodes from a list of websites with the same html format. The HTML sample is here:
<script>
//<![CDATA[
Wistia.iframeInit({"assets":[{"type":"original","slug":"original","display_name":
"Original file","ext":"mp4","size":2,"bitrate":2677,"public":true,
"url":"https://embed-ssl.wistia.com/deliveries/1.bin"},
{"type":"original","slug":"original","display_name":"Original file",
"ext":"mp4","size":1,"bitrate":2677,"public":true,
"url":"https://embed-ssl.wistia.com/deliveries/2.bin"},
//]]>
</script>
I am unable to extract the CDATA information with excel VBA alone it seems. Each time I use the following script below, I obtain either blank or "[object HTMLScriptElement]"
Sub test()
Dim ie As Object
Dim html As Object
Dim mylinks As Object
Dim link As Object
Dim lastRow As Integer
Dim myURL As String
Dim erow As Long
Set ie = CreateObject("InternetExplorer.Application")
lastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
myURL = Sheet1.Cells(i, "A").Value
ie.navigate myURL
ie.Visible = False
While ie.readyState <> 4
DoEvents
Wend
Set html = ie.document
Set mylinks = html.getElementsByName("script")(1).innerText
For Each link In mylinks
erow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Value = link
Cells(erow, 1).Columns.AutoFit
Next
End Sub
As of my experiences, automating the Internet Explorer is highly unstable. So I would use XMLHTTP as long as possible. Of course your HTML tag soup is not XML and cannot be parsed as such. But we can at least get the responseText with XMLHTTP and then using text methods further.
Example:
Sub test()
sURL = "https://fast.wistia.net/embed/iframe/vud7ff4i6w"
Dim oXMLHTTP As Object
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.Send
sResponseText = oXMLHTTP.responseText
aScriptParts = Split(sResponseText, "<script", , vbTextCompare) 'separate in parts delimited with <script
For i = LBound(aScriptParts) + 1 To UBound(aScriptParts) 'lbound+1 because the first part should not be script. It is the body html.
sScriptPart = Split(aScriptParts(i), "</script", , vbTextCompare)(0) 'only the part before </script belongs to the script
MsgBox sScriptPart
Next
End Sub
You could also use regular expressions instead of the Split approach to separate the script parts from the whole text. But this you should ask the RegEx specialists with a separate question then. I'm not such a RegEx specialist.
i have written a lot of javascript functions that i want to use in my vb6 app for efficiency and time saving
is it possible to call java-script function from vb6?
if possible, can you help me with some code?
I hesitate to say this, but you could use the Windows Script Control ActiveX control and embed it in your VB6 application and then run your javascript code possibly with some minor adjustments, but DON'T DO IT. You might think it is efficient and time saving for you, but the reality is you will spend all sorts of extra time dealing with your "work around." Additionally, porting your code to VB6 will make it run much faster. I would only use the scripting method if you need some sort of extensibility.
Add a reference to the scripting runtime and the script control 1.0.
NOTE: in this example the variable scode is the javascript code passed to the function as a string. Since the code is simply a string you can pass in any variables you want, however, getting things back from the code is much more complex. The code can be created on the fly or retrieved from a text file.
In the example, the code is passed as a string and then the string is searched to see if it contains a function called OnProgramLoad. If it does, that function is called.
Public Sub OnProgramLoad(byval scode as string)
Dim sctest As ScriptControl
If Len(scode) < 1 Then Exit Sub
If InStr(1, scode, "OnProgramLoad", vbTextCompare) = 0 Then Exit Sub
Set sctest = New ScriptControl
With sctest
.Language = "JScript"
.AllowUI = True
.AddObject "Application", App
.AddObject "Clipboard", Clipboard
.AddObject "Printer", Printer
.AddObject "Screen", Screen
.AddCode scode
.Run "OnProgramLoad"
End With
Set sctest = Nothing
End Sub
You would be better off porting your routines to VB6 and if you need access to a regex library in VB6 there are better ways:
http://support.microsoft.com/kb/818802
Add a reference to Microsoft VBScript Regular Expressions 5.5, then port your code...
Function TestRegExp(myPattern As String, myString As String)
'Create objects.
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim RetStr As String
' Create a regular expression object.
Set objRegExp = New RegExp
'Set the pattern by using the Pattern property.
objRegExp.Pattern = myPattern
' Set Case Insensitivity.
objRegExp.IgnoreCase = True
'Set global applicability.
objRegExp.Global = True
'Test whether the String can be compared.
If (objRegExp.Test(myString) = True) Then
'Get the matches.
Set colMatches = objRegExp.Execute(myString) ' Execute search.
For Each objMatch In colMatches ' Iterate Matches collection.
RetStr = RetStr & "Match found at position "
RetStr = RetStr & objMatch.FirstIndex & ". Match Value is '"
RetStr = RetStr & objMatch.Value & "'." & vbCrLf
Next
Else
RetStr = "String Matching Failed"
End If
TestRegExp = RetStr
End Function