Copy specific image from webpage and paste into Excel using VBA - excel

I'm trying to take a character string from a cell, copy it into a free QR code generator (ex| http://goqr.me/ ), and bring the resulting image back into my spreadsheet. (I like this generator because you don't need to click "submit" - it updates the image as the text is entered. Assuming/hoping that feature makes this easier)
I'm trying to avoid the installation of new barcode fonts and the purchasing of barcode specific packages.
Using the below code, I can get the browser to open and enter the desired text. I need a way to get the image back into my spreadsheet now. The code I'm using currently just returns "[object]" (as text) in cell C1.
How can I use VBA to get this image onto my clipboard?
Public ieApp As Object
Sub Barcode()
Dim ieDoc As Object
Dim InputBox As Object
Dim qrBoxImage as Object
barcodeTerm = Range("B1").Value
If TypeName(ieApp) = "Object" Or TypeName(ieApp) = "Nothing" Then
Set ieApp = CreateObject("InternetExplorer.Application")
ieApp.Navigate ("http://goqr.me/")
End If
While ieApp.ReadyState <> 4
DoEvents
Wend
ieApp.Visible = True
Set ieDoc = ieApp.Document
Set InputBox = ieDoc.getElementsByName("text")
Set qrBoxImage = ieDoc.getElementByID("qrcode-preview-image")
InputBox.Item(0).Value = barcodeTerm
Range("C1").Value = qrBoxImage
Set ieDoc = Nothing
End Sub

You can follow the steps detailed over here:
http://social.technet.microsoft.com/wiki/contents/articles/23860.print-screen-to-an-image-using-access-vba.aspx
Although the example is used in Access, it's still VBA code so it still should work in Excel

Related

Unable to copy text from Excel to website, showing Run-time error

I am currently having trouble trying to insert text into the website "www.skyvector.com". I've been trying to paste some text in the "Route" field, which appears in a grey box at the top left (usually after clicking 'Flight Plan').
This is the code that I have so far, which has worked for other websites, but strangely not for SkyVector:
Sub test1()
Dim IE As Object
Dim doc As HTMLDocument
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://www.skyvector.com/"
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Set doc = IE.document
doc.getElementsById("sv_planEditField").Value = "test"
End Sub
Unfortunately, an error appears whenever this line is set to run:
doc.getElementsById("sv_planEditField").Value = "test"
The error is "Run-time error '438': Object doesn't support this property or method".
Been wracking my head for a solution to this, and I couldn't find any solution here as well, specifically for websites that work like SkyVector. I am not exactly sure what the difference is between that and any other website. Thank you very much for your time!
First of all, the method name is not getElementsById(). The name is getElementById() without the s for plural. The reason is, an ID should be only used once in a html document, it's unique.
But if you use the right name you will receive the error that there is no object. The reason here is, there is no element with an ID named sv_planEditField.
So what can you do? You can use another method called getElementsByClassName() because the html line in question is
<input autocomplete="false" spellcheck="false" class="sv_search" autocorrect="off">
The method getElementsByClassName() buids a node collection. Therefore it uses the s for plural. There can be as many elements with the same class name as the developer want. You can get a specific element by it's index like you use it with an array. The clss name sv_search is only once used in the document. A node collections first index is allways 0. So you must use the following line of vba code, instead of yours:
doc.getElementsByClassName("sv_search")(0).Value = "test"
Edit
After reading your question again and understand it ;-) and based on the answer of Sam here is the way you can solve your problem. What you need is a new text node and (I think) to trigger the right event to make the input work for the page. Try it with original data.
Sub test1()
Dim IE As Object
Dim textToEnter As Object
Dim nodeToAppendText As Object
Dim nodeText As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://www.skyvector.com/"
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
'Open overlay to enter data
IE.document.getElementsByClassName("sv_topbarlink")(0).Click
'Click textfield to hide helptext and place curser
IE.document.getElementsByClassName("svfpl_helpmessage")(0).Click
'Create a text node which belongs to the document
Set textToEnter = IE.document.createTextNode("Test")
'Get the node you want to append the new text node
Set nodeToAppendText = IE.document.getElementById("sv_planEditField")
'Append the new text node
Set nodeText = nodeToAppendText.appendChild(textToEnter)
'Not sure if it is necessary to trigger an event
'But there are two events in question:
' First one is input
' Second one is keypress
'You must try how it works
Call TriggerEvent(IE.document, nodeToAppendText, "input")
End Sub
If needed use this method to trigger any event:
Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)
Dim theEvent As Object
htmlElementWithEvent.Focus
Set theEvent = htmlDocument.createEvent("HTMLEvents")
theEvent.initEvent eventType, True, False
htmlElementWithEvent.dispatchEvent theEvent
End Sub
The element sv_planEditField is not a normal text box. Open it in your browser and inspect it with the developer tools (Press F12). Do this both before and after filling it. You will notice that this is quite different from a standard input. Either recreate the html structure of the filled control or recreate the form submission. Have a look at createElement and appendChild for more information.

Excel VBA IE Object and using dropdown list

I am experimenting with web automation and struggling a bit trying to utilize a drop down list.
My code works up to the point of searching for a company name and hitting "go". On the new page I can't seem to find the right code that selects the group of elements that represents the drop down list. I then want to select "100" entries, but I can't even grab the nodes that represent this list.
I have been browsing multiple different pages on stackoverflow that talk about CSS selectors and looked at tutorials but that doesn't seem to help either. I either end up grabbing nothing, or whatever I grab can't use the getElementsByTagName method, which ultimately I am trying to drill down into the td and select nodes . Not sure what to do with those yet, but I can't even grab them. Thoughts?
(note stopline is just a line that I use a breakpoint on to stop my code)
CSS helper website: https://www.w3schools.com/cssref/trysel.asp
Code:
Option Explicit
Sub test()
On Error GoTo ErrHandle
Dim ie As New InternetExplorer
Dim doc As New HTMLDocument
Dim ws As Worksheet
Dim stopLine As Integer
Dim oSearch As Object, oSearchButton As Object
Dim oForm As Object
Dim oSelect As Object
Dim list As Object
Set ws = ThisWorkbook.Worksheets("Sheet1")
ie.Visible = True
ie.navigate "https://www.sec.gov/edgar/searchedgar/companysearch.html"
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set doc = ie.Document
Set oSearch = doc.getElementById("companysearchform")
Set oSearchButton = oSearch.getElementsByTagName("input")(1)
Set oSearch = oSearch.getElementsByTagName("input")(0)
oSearch.Value = "Summit Midstream Partners, LP"
oSearchButton.Click
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set doc = ie.Document
Set list = doc.querySelectorAll("td select")
stopLine = 1
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
td select will return a single node so you only need querySelector. The node has an id so you might as well use the quicker querySelector("#count") to target the parent select. To change the option you can then use SelectedIndex on the parent select, or, target the child option by its value attribute querySelector("[value='100']").Selected = True. You may then need to attach and trigger change/onchange htmlevent to the parent select to register the change.
However, I would simply extract the company CIK from current page then concatenate the count=100 param into the url and .Navigate2 that using following format:
https://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=0001549922&type=&dateb=&owner=include&count=100&search_text=
You can extract CIK, after initial search company click and wait for page load, with:
Dim cik As String
cik = ie.document.querySelector("[name=CIK]").value
ie.Navigate2 "https://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=" & cik & "&type=&dateb=&owner=include&count=100&search_text="
Given several params are left blank you can likely shorten to:
"https://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=" & cik & "&owner=include&count=100"
If you are unable to get the initial parent select you probably need a timed loop waiting for that element to be present after clicking the search button. An example is shown here in a StackOverflow answer.

Using Excel VBA to automate form filling in Internet Explorer

I want to take values from an excel sheet and store them in an array. I then want to take the values from the array and use them to fill the web form.
I have managed to store the values in the array and I have managed to get VBA to open Internet Explorer (IE)
The code runs and no errors appear, but the text fields are not being populated, nor is the button being clicked
(The debugger points to [While .Busy] as the error source, located in the WITH block)
How do I go about filling the form (that has a total of 3 text boxes to fill)?
There is also a drop down menu that I need to choose a value from, but I need to fill the text boxes prior to moving on to that part of the task.
Sub CONNECT_TO_IE()
the_start:
Dim ie As Object
Dim objElement As Object
Dim objCollection As Object
acct = GET_CLIENT_NAME()
name = GET_CODE()
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate ("<<my_website>>")
ie.FullScreen = False
On Error Resume Next
Do
DoEvents
If Err.Number <> 0 Then
ie.Quit
Set ie = Nothing
GoTo the_start:
End If
Loop Until ie.readystate = 4
Application.Wait Now + TimeValue("00:00:10")
ie.Document.getElementbyid("<<field_1>>").Value = "PPP"
ie.Document.getElementbyid("<<field_2>>").Value = "PPP"
ie.Document.getElementbyid("<<field_3>>").Click
Set ie = Nothing
End Sub
UPDATE: Turns out the reason this wasn't working is because there are some settings in the HTML of the site that do not allow for the automation to occur, so any code versions I had were correct but they were doomed to fail. So you were correct in that regard #TimWilliams.
I know this because the website I was trying to access is on a secure server/virtual machine. I edited the code to fill in the google search bar and it did not work on the virtual machine however when I ran the same code locally, it worked fine.

How to input values into dropdown box of web page using Excel VBA

I'm trying to operate a website to display desired option chain data with an Excel VBA macro. The website -- CBOE.com -- has an input field for the ticker symbol of the desired option chains. My code has been able to drive that part of the webpage and a default option chain is displayed. It defaults to the most current month that options expire (May 2018 as of this note). From there the user can input other expiration dates for which to have other option chains (for the same symbol) to be retrieved and displayed. This is where my code seems to be breaking down.
Just above the default option chain display is a dropdown input box labeled "Expiration:" where a list of other expiration months can be selected. Once selected, a green Submit button must be clicked to get the specified option chain for the selected expiration month. Alternatively, below the default option chain are explicit filter buttons for expiration months also.
As said, my code gets to the point of specifying the symbol and getting default option chains displayed, but I can't seem to get the dropdown input field for other expiration months to work.
If anyone can see where and how my code is deficient, I'd really appreciate that insight.
Many thanks.
--Mark.
Here is my core code in question:
Sub getmarketdata_V3()
Dim mybrowser As Object, myhtml As String
Dim htmltables As Object, htmltable As Object
Dim htmlrows As Object, htmlrow As Object
Dim htmlcells As Object, htmlcell As Object
Dim xlrow As Long, xlcol As Integer
Dim exitat As Date, symbol As String
Dim flag As Integer
On Error GoTo errhdl
Const myurl = "http://www.cboe.com/delayedquote/quote-table"
symbol = UCase(Trim(Range("ticker").Text))
With Range("ticker").Worksheet
Range(Range("ticker").Offset(1, 0), Cells(Rows.Count, Range("ticker").Column + 13)).ClearContents
End With
Set mybrowser = CreateObject("internetexplorer.application")
mybrowser.Visible = True
mybrowser.navigate myurl
While mybrowser.busy Or mybrowser.readyState <> 4
DoEvents
Wend
With mybrowser.document.all
exitat = Now + TimeValue("00:00:05")
Do
.Item("ctl00$ContentTop$C002$txtSymbol").Value = symbol
.Item("ctl00$ContentTop$C002$btnSubmit").Value = "Submit"
.Item("ctl00$ContentTop$C002$btnSubmit").Click
If Err.Number = 0 Then Exit Do
Err.Clear
DoEvents
If Now > exitat Then Exit Do
Loop
End With
'This With statement is to refresh the mybrowser.document since the prior With statement pulls up a partially new webpage
With mybrowser.document.all
On Error Resume Next
exitat = Now + TimeValue("00:00:05")
'Tried using "ID" label to select desired month--in this case 2018 July is a dropdown option:
'Usind this label seems to blank out the value displayed in the dropdown input box, but does not cause
'any of the options to display nor implant "2018 July" in it either. It just remains blank and no new option
'chain is retrieved.
.Item("ContentTop_C002_ddlMonth").Select
.Item("ContentTop_C002_ddlMonth").Value = "2018 July"
.Item("ContentTop_C002_ddlMonth").Click
'Then tried using "Name" label to select desired month--in this case 2018 July is an option:
' .Item("ctl00$ContentTop$C002$ddlMonth").Value = "2018 July"
' .Item("ctl00$ContentTop$C002$ddlMonth").Click
' .Item("ctl00$ContentTop$C002$btnFilter").Value = "View Chain"
' .Item("ctl00$ContentTop$C002$btnFilter").Click
End With
While mybrowser.busy Or mybrowser.readyState <> 4
DoEvents
Wend
'Remaining logic, except for this error trap logic deals with the option chain results once it has been successfully retrieved.
'For purposes of focus on the issue of not being able to successfully have such a table displayed, that remaining process logic is not
'included here.
errhdl:
If Err.Number Then MsgBox Err.Description, vbCritical, "Get data"
On Error Resume Next
mybrowser.Quit
Set mybrowser = Nothing
Set htmltables = Nothing
End Sub
For your code:
These 2 lines change the month and click the view chain (I tested with symbol FLWS). Make sure you have sufficient delays for page to actually have loaded.
mybrowser.document.querySelector("#ContentTop_C002_ddlMonth").Value = "201809"
mybrowser.document.querySelector("#ContentTop_C002_btnFilter").Click
I found the above sketchy for timings when added into your code so I had a quick play with Selenium basic as well. Here is an example with selenium:
Option Explicit
'Tools > references > selenium type library
Public Sub GetMarketData()
Const URL As String = "http://www.cboe.com/delayedquote/quote-table"
Dim d As ChromeDriver, symbol As String
symbol = "FLWS"
Set d = New ChromeDriver
With d
.Start
.Get URL
Dim b As Object, c As Object, keys As New keys
Set b = .FindElementById("ContentTop_C002_txtSymbol")
b.SendKeys symbol
.FindElementById("ContentTop_C002_btnSubmit").Click
Set c = .FindElementById("ContentTop_C002_ddlMonth")
c.Click
c.SendKeys keys.Down 'move one month down
.FindElementById("ContentTop_C002_btnFilter").Click
Stop '<<delete me later
.Quit
End With
End Sub
Try the below approach, in case you wanna stick to IE. I tried to kick out hardcoded delay from the script. It should get you there. Make sure to fill in the text field with the appropriate ticker from the below script before execution.
There you go:
Sub HandleDropDown()
Const url As String = "http://www.cboe.com/delayedquote/quote-table"
Dim IE As New InternetExplorer, Html As HTMLDocument, post As Object, elem As Object
With IE
.Visible = True
.navigate url
While .Busy Or .readyState <> 4: DoEvents: Wend
Set Html = .document
End With
Do: Set post = Html.getElementById("ContentTop_C002_txtSymbol"): DoEvents: Loop While post Is Nothing
post.Value = "tickername" ''make sure to fill in this box with appropriate symbol
Html.getElementById("ContentTop_C002_btnSubmit").Click
Do: Set elem = Html.getElementById("ContentTop_C002_ddlMonth"): DoEvents: Loop While elem Is Nothing
elem.selectedIndex = 2 ''just select the month using it's dropdown order
Html.getElementById("ContentTop_C002_btnFilter").Click
End Sub
Reference to add to the library:
Microsoft Internet Controls
Microsoft HTML Object Library

MSC .getElementById or .getElementByClassName

I'm currently having a bit of a problem, because i can't create a proper VBA code for my excel to enter data from cell to particular website. Could You please help me with it ?
Sub MSC()
Dim OrgBox As HTMLInputElement
Set objIE = New SHDocVw.InternetExplorer
objIE.navigate "http://www.mscgva.ch/tracking/index.html"
objIE.Visible = True
Do While objIE.readyState < 4: Loop
Set OrgBox = objIE.getElementById("InputBox")
OrgBox.Value = Range("a1")
OrgBox.form.submit
End Sub
The element you're trying to control is in an iframe. To control elements inside an iframe, you need to extract the src attribute from the tag and navigate to that URL
ifr_url = ie.document.getElementsByTagName("iframe")(0).src
in your case ifr_url = "http://tracking.mscgva.ch/msctracking.php"
Once on that webpage your code to insert text should work.

Resources