submitting a cell into a search box on a website

[Roger on Excel]

The following website has a search engine for chemicals

http://ull.chemistry.uakron.edu/erd/

One enters the chemical in the search field and the website pulls up a link
for the chemical detailing chemical properties

If one has a list of chemicals in Excel, is it possible to have a macro
activated so that it will submit each chemical in the list sequentially to
the search engine website and return the hyperlink to the chemical in the
adjacent cell in Excel?

Can anyone help?

Thanks,

Roger

 

[Matthew Herbert]

Roger,

You didn't supply a sample search text, so I don't know what the search
results are supposed to look like. This aside, the procedure/functions below
will return one hyperlink to the spreadsheet. This should be more than
enough code for you to change in orfer to fit your needs (especially since
there is no way for me to test what type of results you do/don't receive).
GetHyperlink assumes that your search text starts in A1 and is contained in
column A.

Best,

Matthew Herbert

Sub GetHyperlink()
Dim rngCell As Range
Dim rngElements As Range
Dim objIE As Object
Dim objSearch As Object
Dim objLinks As Object
Dim objLink As Object
Dim Obj As Object
Dim lngCnt As Long
Dim intCnt As Integer

Const strURL As String = "http://ull.chemistry.uakron.edu"

Set objIE = GetIE(strURL)

If objIE Is Nothing Then
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.navigate strURL & "/erd/"
WaitForLoad objIE
End If

Set rngElements = Range("a1")
If rngElements.Offset(1, 0).Value <> vbNullString Then
Set rngElements = Range(rngElements, rngElements.End(xlDown))
End If

For Each rngCell In rngElements.Cells
Set objSearch = GetTextBoxByTagAndName(objIE)
objSearch.Value = rngCell.Value
objIE.document.forms(0).submit
Set objLinks = objIE.document.Links

intCnt = 0
For Each objLink In objLinks
If intCnt <> 1 Then
rngCell.Offset(0, 1).Formula = "=HYPERLINK(""" & objLink.href &
""")"
intCnt = intCnt + 1
End If
Next objLink
WaitForLoad objIE
Next rngCell
MsgBox "Done"
End Sub

Function GetIE(strAddress As String) As Object

Dim objShell As Object
Dim objShellWindows As Object
Dim Obj As Object
Dim objRet As Object
Dim strURL As String

Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

For Each Obj In objShellWindows
strURL = ""
On Error Resume Next
strURL = Obj.document.Location
On Error GoTo 0
If strURL <> "" Then
If strURL Like strAddress & "*" Then
Set objRet = Obj
Exit For
End If
End If
Next Obj

Set GetIE = objRet
End Function

Function GetTextBoxByTagAndName(objIE As Object) As Object
Dim objTag As Object
Dim Obj As Object

Set objTag = objIE.document.all.tags("input")

For Each Obj In objTag
If Obj.Type = "text" And Obj.Name = "words" Then
Set GetTextBoxByTagAndName = Obj
Exit For
End If
Next

End Function

Sub WaitForLoad(objIE As Object)

Do Until objIE.Busy = False And objIE.ReadyState = 4
Application.Wait (Now() + TimeValue("0:00:01"))
DoEvents
Loop

End Sub

 

[Joel]

You beat me to this. I did something simliar fro somebody at a different
website. I actually create a database from my site for each chemical. The
database was used to help fireman fight fires.


Sub Getchemicals2()

Found = False
For Each sht In Sheets
If sht.Name = "Chemicals" Then
Found = True
Exit For
End If
Next sht
If Found = False Then
Set ChemicalSht = Sheets.Add(after:=Sheets(Sheets.Count))
ChemicalSht.Name = "Chemicals"
Else
Set ChemicalSht = Sheets("Chemicals")
ChemicalSht.Cells.ClearContents
End If


Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

URLFolder = _
"http://www.ilo.org/public/english/protection/safework/cis/products/icsc/dtasht/"
ChemicalRowCount = 1
For Letters = 0 To 25
AlphaLetter = Chr(Asc("a") + Letters)

URL = URLFolder & AlphaLetter & "_index.htm"

'get web page
ie.Navigate2 URL
Do While ie.readyState <> 4
DoEvents
Loop

Do While ie.busy = True
DoEvents
Loop

H2Found = False
For Each itm In ie.Document.all
If H2Found = False Then
If itm.tagname = "H2" Then
H2Found = True
End If
Else

If itm.tagname = "A" Then
If itm.innertext = "" Then Exit For

'chemical name
ChemicalSht.Range("A" & ChemicalRowCount) = itm.innertext
'webpage
ChemicalSht.Range("B" & ChemicalRowCount) = itm.href

ChemicalRowCount = ChemicalRowCount + 1
End If
End If
Next itm

Next Letters

End Sub

 

[Roger on Excel]

Dear Mathew / Joel,

Many thanks for your help - these solutions are very useful

Best regards, Roger