[www.richardsenior.net/projects]
[www.richardsenior.net/projects/searchaccess]
VBA Screen Scraper
No idea what this is, I think I wrote it to help my girlfriend do some work. But it just shows a way to
use VBA to retrieve and parse a web page.
<![CDATA[
Sub scrape()
'LOGIN USE F8
Set web = CreateObject("InternetExplorer.Application")
web.Visible = True
web.navigate "https://www."
Do While web.Busy
DoEvents
Loop
web.document.Forms.login.p_user_name.Value = "dfsg"
web.document.Forms.login.p_password.Value = "sdfg"
'user action required
web.document.Forms.login.p_user_name.Value = "sfg"
web.document.Forms.login.p_password.Value = "sdg"
'LOOP STARTS
For Row = 1344 To 1399
skipflag = False
thisid = Sheets("b").Cells(Row, 2).Value
thisid = Right(thisid, 6)
Do While web.Busy
DoEvents
Loop
web.document.Forms.Search.ID.Value = thisid
web.document.Forms.Search.submit
Do While web.Busy
DoEvents
Loop
foo = ""
For a = 0 To web.document.Links.Length - 1
If InStr(1, web.document.Links(a), "location_new", vbTextCompare) Then
foo = web.document.Links(a).href
Exit For
End If
Next a
If foo <> "" Then
web.navigate (foo)
Else
skipflag = True
web.goback
End If
'get stuff off the page
Do While web.Busy
DoEvents
Loop
hadcomment = False
'set a flag needed later
colref = 9
If Not skipflag Then
For a = 1 To web.document.all.Length - 1
obj = web.document.all(a)
tnode = web.document.all(a).nodeName
If tnode = "#comment" Then
foo = web.document.all(a).innerHTML
If (InStr(1, foo, "new table here", vbTextCompare)) Then
hadcomment = True
End If
End If
If tnode = "TD" And hadcomment Then
thishtml = web.document.all(a).innerHTML
If InStr(1, thishtml, "<B>Class:</B>", vbTextCompare) Then
colref = 23
thishtml = "ifstatementgotme"
End If
If InStr(1, thishtml, "<B>Grid Reference:</B>", vbTextCompare) Then
colref = 24
thishtml = "ifstatementgotme"
End If
Select Case thishtml
Case "ifstatementgotme"
Case "<B>Location:</B>"
colref = 10
Case "<B>Cell Ref:</B>"
colref = 11
Case "<B>Address:</B>"
colref = 12
Case "<B>Postcode:</B>"
colref = 13
Case "<B>Directions:</B>"
colref = 15
Case "<B>Site Notes:</B>"
colref = 19
Case "<B>Equipment Access:</B>"
colref = 20
Case "<B>Aerial Access:</B>"
colref = 21
Case "<B>Site Safety:</B> "
colref = 22
Case Else
If colref <> 9 Then
If tnode = "TD" Then
Sheets("b").Cells(Row, colref).Value = thishtml
colref = 9
End If
End If
End Select
End If
Next a
' back
web.goback
web.goback
End If 'not skipflag
Next Row
End Sub
]]>