I am trying to extract from this website using VBA the element Title in format text on this code
<div class="train-logo
train-logo-monochrome
train-logo--trenitalia-monochrome
train-logo--frecciarossa-monochrome" title="Trenitalia">
</div>
VBA:
For Each treno In IE.Document.getelementsbytagname("div")
If treno.getattribute("title") Then
Cells(rownumber2, "u").Value = treno.innertext
Something like this should work:
Dim treno, t
For Each treno In IE.Document.getelementsbytagname("div")
t = treno.getattribute("title")
If t <> "" Then Cells(rownumber2, "u").Value = t
Next treno
It's not clear from your question how many of these you need to read from the page: if just one you can Exit For after getting the value.
Related
In MS Word, you can create hyperlinks to a "Place in this document" so that a link takes you someplace else in the same Word file. However, if you change headers or move things around these links will sometimes break. I want to write some VBA to check for broken links.
With VBA, you can list each hyperlink subaddress using the code below:
Sub CheckLinks()
Set doc = ActiveDocument
Dim i
For i = 1 To doc.Hyperlinks.Count
Debug.Print doc.Hyperlinks(i).SubAddress
Next
End Sub
The output from the code above also matches what is shown in the field codes for the hyperlink.
However, I'm not really clear on how to verify if the SubAddress is correct. For example, an excerpt from the program output shows this:
_Find_a_Staff_1
_Edit_Organization_Settings_2
_Set_the_Staff
_Find_a_Staff_1
But there's no obvious way to tell what the "correct" suffix should be for a given heading. Any thoughts on how to check if these are valid?
Is there a way to get the list of all valid subaddresses for the headings in the document?
The code below will list the hyperlinks where the corresponding bookmark does not exist in the document. (Note that it only detects missing links, not links that go to the wrong place.)
Sub CheckLinks()
Dim doc As Document
Set doc = ActiveDocument
Dim i, j
Dim found As Boolean
For i = 1 To doc.Hyperlinks.Count
found = False
For j = 1 To doc.Bookmarks.Count
If doc.Range.Bookmarks(j).Name = doc.Hyperlinks(i).SubAddress Then
found = True
End If
Next
If found = False Then
Debug.Print doc.Hyperlinks(i).SubAddress
End If
Next
End Sub
First, I am very new with VBA and have only got as far as I am with solutions from other questions asked online. What I have is a macro that opens IE to a specified URL, enters text into a search, loads the results, then loops the search through more specific search values.
What I am trying to do is scrape the results of a search into excel. However, the results don't appear in the resulting HTML code but look to be generated by a script on the website.
An example of the page I am searching:
https://www.gamestop.com/PickUpAtStore/75083/0/917850
When loaded the results are found on the page, but not in the page source. Looking at the page source there looks to be a script that pulls the results in:
<script id="stores" type="text/x-handlebars-template">
{{#if this}}
<ul>
{{#each this}}
<li id="{{StoreNumber}}|{{#if true}}917850 {{/if}}" class="{{#if false}}checkOnly{{/if}}"">
<div class="fluidWrapper ats-storelist" id="{{StoreNumber}}">
<div class="contactInfo">
<div class="title ats-storetitle">{{DisplayName}}</div>
<div class="address ats-storeaddress">
{{{AddressStreet}}}<br />{{AddressCityStateZip}}
</div>
<div class="phoneNumber ats-storephone">
{{Phone}}
</div>
</div>
<div class="rightInfo">
<div class="distance ats-storedistance">{{Distance}} {{#if true}}<i id="showHoldOptions_{{StoreNumber}}" class="{{#if false}} plus_{{/if}}icon"></i>{{/if}}</div>
</div>
</div>
..................
Ideally, what I would like to happen is when the results are loaded the store name, address and phone # are put into excel starting at A4, B4, C4 and adding each store to the next line.
Am I looking in the entirely wrong place to grab these results? I appreciate any help solving this.
edit adding current macro:
Sub Search_Cell()
Dim ie As Object
Dim lRow As Long
Dim URL As Range
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
For Each URL In Range("B1")
ie.navigate URL.Value
Application.StatusBar = "Submitting"
While ie.Busy
DoEvents
Wend
Next
For lRow = 1 To 89
With ie.document
.all("puas_search").Value = Sheets("Zipcodes").Range("A" & lRow).Value
.getElementById("puas_search").Focus
End With
Application.SendKeys ("~")
Application.Wait Now + #12:00:02 AM# 'wait 2 seconds
' Get results of search
' Add Store name to A4, Address to B4, Phone# to C4 (but for following searches start at the next empty row)
' Add following results to next row
Next lRow 'loop to next search
ie.Quit
Set ie = Nothing
MsgBox "Done"
End Sub
I solved this, I was entirely wrong thinking that the results couldn't be scraped from the html. Thank You #Tigregalis for nudging me in the right direction.
Here is the snippet of code that pulls the data I need, places it in the correct location in excel, then moves the to next row.
Set HTMLDoc = IE.document
Set Stores = HTMLDoc.getElementsByClassName("contactInfo")
For Each Store In Stores
ColNum = 1
For Each Name In Store.Children
Cells(RowNum, ColNum) = Name.innerText
ColNum = ColNum + 1
Next Name
RowNum = RowNum + 1
Next Store
I am running into an issue with my macro that works on Excel 2013 but will not work on Excel 2010. I am trying to click a gif that is on the webpage but for some reason it does not "see" it.
The HTML I am using is as follows:
<a href="#" style="color:#009900;">
<img src='images/CheckMarkGreen.gif' border=0 alt='Select This Item'>
</a>
And the VBA I am using is:
Dim imgElm
For Each imgElm In objIE.Document.getElementsByTagName("img")
If imgElm.innertext = "images/CheckMarkGreen.gif" Then
imgElm.Click
Exit For
End If
Next
Any help would be appreciated!
Image elements don't have an innerText (maybe you mean innerHTML?)
Easier maybe to check the alt attribute:
If imgElm.getAttribute("alt") = "Select This Item" Then
imgElm.Click
Exit For
End If
Dim imgElm as IHTMLElement
For Each imgElm In objIE.Document.getElementsByTagName("img")
If imgElm.getAttribute("src") = "images/CheckMarkGreen.gif" Then
imgElm.Click
Exit For
End If
Next
OR
Dim imgElm as HTMLImg
For Each imgElm In objIE.Document.getElementsByTagName("img")
If imgElm.src = "images/CheckMarkGreen.gif" Then
imgElm.Click
Exit For
End If
Next
I'm using VBA to try to scrape a time/date from a website. The item I'm trying to extract it from is a text box that leads to a drop down calendar. Inside of the text box I can see and select the text I want to extract. Here is the HTML:
<input type="text" date-begin="ac.Start" date-end="ac.Finish" ng-model="Data.estRange" ng-change="updateDuration()" size="45" style="display:inline;" name="estRange" id="estRange" value="" rangepicker="" class="ng-isolate-scope ng-valid ng-dirty ng-valid-date-range">
Inside of the text box it says, "mm/dd/yyyy hh:mm PM - mm/dd/yyyy hh:mm PM".
When I try to grab the inner text nothing gets returned. Here is an example of the code I tried to use:
Set objinputs = aExplorer.document.getElementsByTagName("input")
For Each ele In objinputs
If ele.TagName Like "date-end" Then
cTestScrape = ele.innertext
End If
Next
Do While aExplorer.Busy
Application.Wait DateAdd("s", 10, Now)
Loop
Any ideas on how to do this correctly? Thanks!
Per Sorceri (thanks!),
Even though the ele.Value string is listed as blank in the HTML, pulling the .value data correctly pulled in the date/time listed with one additional modification to the code (changing the ele.tagname). Here is the correct code.
Set objinputs = aExplorer.document.getElementsByTagName("input")
For Each ele In objinputs
If ele.Name Like "estRange" Then
cTestScrape4 = ele.Value
End If
Next
Do While aExplorer.Busy
Application.Wait DateAdd("s", 10, Now)
Loop
I have a fully functional macro that goes through a list of personnel records and works out if they are leavers or never started. The only issue is its a very slow process when search the string created with all the HTML code (~10000 characters)
I was wondering if there is a way to restrict the retrieve to be just part of the webpage
The macro i am currently using is below, this macro iterates through each row and pulls in the code from the URL for each persons personnel page
Sub RetrieveEndDate()
Dim myArray() As Variant, Search As Variant
Dim strURL As String, strCSV As String, dbClose As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Call LogOn
RowsWithData = Application.CountA(Range("A:A"))
For R = 2 To RowsWithData
Application.StatusBar = R & " Out of " & RowsWithData
UKNo = Cells(R, 1).Value
strURL = "http://www.pers.fs.com/People_Detail.asp?Pers_no=" & UKNo & "&mode=CURRENT"
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strCSV = http.responseText
Cells(R, 3).Value = strCSV
'Works of if employee has left, never started or if neither of them leaves blank
If InStr(1, strCSV, "Employee has Left") > 0 Then
Cells(R, 2).Value = "Left"
ElseIf InStr(1, strCSV, "Non-Starter") > 0 Then
Cells(R, 2).Value = "Did not start"
Else
Cells(R, 2).Value = ""
End If
Set http = Nothing
Next R
1
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
The retrieve from the webpage is ~10000 characters long, but the info i am interested in is at the beginning of the page as below "(Employee has Left)"which is on the 3rd from bottom line
<head>
<title> List</title>
<link rel="stylesheet" href="_stylesheets/atc.css" type="text/css">
</head>
<body CLASS="Skill" >
<form name="People_Detail" method="Post" action=History_list.asp>
<P><INPUT id="Pers_No" type = "HIDDEN" name="Pers_No" value=UK111111 ></P>
<P><INPUT id="mode" type = "HIDDEN" name="mode"Value="HISTORY_LIST"></P>
<Table Border = 0 CellPadding = 0 width = 100% >
<TR><TR><TD Colspan = 2 ><H1 id=Test name=test>Current Active Record<BR>(Employee has Left)</H1><TD align = right>
<P><INPUT id="btnSubmit" name="btnSubmit" type="SUBMIT" value="View Record History List"></P>
</TD></TD></TR></TR>
AFAIK there is no way do this with XMLHTTP.
This KB article contains code that performs a download using the WinInet API.
The While bDoLoop loop reads the URL in Len(sReadBuffer) chunks, you can modify this to add a condition and exit the loop whenever you like.
If you wanted to begin the download at a specific offset (and the server supports it) you could also try InternetSetFilePointer.
I had a similar problem. The reponse text at a certain website was sooo big that it was taking my macro forever to search through it. A solution that I came up with is as follows. First I used the SPLIT function on the response text.
arr_1 = Split(my_var, "zc-st-a", -1, vbTextCompare)
You didn't provide enough of the source code for me to be specific, but there is usually some tag you can split on that breaks the response text down into array elements with data you want and those elements without useful information. Next use the FILTER function to filter out the useless elements in arr_1
arr_2 = Filter(arr_1, "zc-pg-y", True, vbTextCompare)
Finally, you can combine the useful elements that are present in arr_2 using the JOIN function.
my_var = Join(arr_2, " ")
In my case, using this method to make the response text smaller reduced my macro run time from 1 hour 15 minutes to 15 minutes. Hope this helps