View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Matthew Herbert[_3_] Matthew Herbert[_3_] is offline
external usenet poster
 
Posts: 149
Default submitting a cell into a search box on a website

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


"Roger on Excel" wrote:

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