retrieving data from a table on a website

R

ron

There is a internet page with chemical data :

http://spreadsheets.google.com/pub?key=twQ35hFIq-y0N84xQ5l0ICQ&output....

It has chemicals in the first column and proerties in adjacent columns.

Is there a way to have a userform lookup a chemical in a textbox from the
websites 1st column and then populate other textboxes with the adjacent data
from the table?

Can anyone help?

Thanks,

Roger

Hi Roger...The following code should give you what you want. It finds
the chemical name to search for in cell A2 and places the data of
interest in cell B2. You can polish it by breaking the text string
containing the data into columns and putting in a header for each
column. Also you can adopt it to text boxes rather than cells should
you choose...Ron

Sub Chem_Name()

' Name of chemical of interest is in A2
chem = Range("A2")

' Get the source code from the website
my_url = "http://spreadsheets.google.com/pub?key=twQ35hFIq-
y0N84xQ5l0ICQ&output=html"
Set my_obj = CreateObject("MSXML2.XMLHTTP")
my_obj.Open "GET", my_url, False
my_obj.send
my_var = my_obj.responsetext
Set my_obj = Nothing

' Locate beginning and end of data for chemical of interest
loc_1 = InStr(1, my_var, chem, vbTextCompare)
loc_2 = InStr(loc_1, my_var, "S3", vbTextCompare)

' Extract and data of interest and remove unecessary characters
chem_text = Mid(my_var, loc_1, loc_2 - loc_1)
chem_text = Replace(chem_text, "Acetone", "")
chem_text = Replace(chem_text, "class=", "")
chem_text = Replace(chem_text, "'s2'", "")
chem_text = Replace(chem_text, "<td >", ", ")
chem_text = Replace(chem_text, "<td '", "")

' Put data in B2
Range("B2") = chem_text
End Sub
 
P

Peter T

Looks like a simple WebQuery will get it -

Sub QueryChemicalData()
Dim sUrl As String

' two parts to avoid line wrapping!
sUrl = "http://spreadsheets.google.com/pub?key="
sUrl = sUrl & "twQ35hFIq-y0N84xQ5l0ICQ&output=html"

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & sUrl _
, Destination:=Range("A1"))
.Name = "ChemicalData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False ' << note default is True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

' and to update -
Sub RefreshQ()
Dim qt As QueryTable

Set qt = ActiveSheet.QueryTables("ChemicalData")
'qt.BackgroundQuery = False
qt.Refresh

End Sub

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top