[AccessD] Read data off a live html table

Would have been easier if they punted this out in xml for a quicker 
parse but you can also get web text with xmlhttp
Web page returned  also flunks XHTML compliance
 see http://validator.w3.org/
which also might have helped,
 but then the Inet method is probably quicker.

'This code fires off request to specified WEB page
'returns html, asp, xml, or text page in text string then sent to file 
on disk
'Makes use of the XMLHTTPRequest object contained in msxml.dll.
'Check off Reference to MSXML Version 2.0 3.0
' I am using latest Version of IE5
' should also work with IE5.0 MSXML ver 2.0,2.6, 3.0 etc

'GrabTextFileFromWebSite 
("http://www.hdnl.co.uk/tracker.aspx?UPI=806290025850a")

Public Sub GrabTextFileFromWebSite(strMyURL As String)
  
     Dim oHttp As Object
     Dim strFileName As String
    
    'make use of the XMLHTTPRequest object contained in msxml.dll
    ' Set oHttp = CreateObject("Microsoft.XMLHTTP")
    Set oHttp = CreateObject("MSXML2.XMLHTTP.4.0")
    'oHttp.setRequestHeader "Content-Type", 
"application/x-www-form-urlencoded"
    'oHttp.setRequestHeader "Content-Type", "text/xml"
    'oHttp.setRequestHeader "Content-Type", "multipart/form-data"
      
  
     'oHttp.Open "GET", "http://www.amazon.com", False
    
       oHttp.Open "GET", strMyURL, False
      
    ' stick in your web page above , file type can be anything asp txt 
xml html etc.
    'depends partially on content type
    'oHttp.setRequestHeader "Content-Type", 
"application/x-www-form-urlencoded"
     oHttp.setRequestHeader "Content-Type", "text/xml"
    oHttp.send
   
 
    
     'check the feedback
     Debug.Print "Ready State =" & oHttp.ReadyState
     'normal state =4
     Debug.Print "Status =" & oHttp.status
     'normal status = 200
     Debug.Print "Status Text =" & oHttp.statusText
    ' Debug.Print oHttp.getAllResponseHeaders()
    'Debug.Print "Response Body =" & oHttp.responseBody
    ' Debug.Print "Response Body =" & StrConv(oHttp.responseBody, vbUnicode)
    'Debug.Print "Response Text =" & oHttp.responseText
    'Parse response text string here or send to file
    'create directory structure if not in existance
    'CreateDirectoryStruct ("c:\Accesshtmlstealer")
   ' MsgBox oHttp.responseXML.xml 'no xml returned? missing MIME
   
    strFileName = "c:\Accesshtmlstealer\Gustav"
    strFileName = strFileName & Format(Now, "yyyymmddhhmmss") & ".txt"
   
       WriteFile strFileName, oHttp.responseText
       findtable (oHttp.responseText)
        '
        Exit Sub
       
ErrorHandler:
        MsgBox Err.Description & vbCrLf & Err.Number
        '
        Resume Next
   
End Sub
Public Sub WriteFile(ByVal sFileName As String, ByVal sContents As String)
' Dump XML  String to File for debugging
    Dim fhFile As Integer
    fhFile = FreeFile
   ' Debug.Print "Length of string=" & Len(sContents)
    Open sFileName For Output As #fhFile
    Print #fhFile, sContents;
    Close #fhFile
    Debug.Print "Out File " & sFileName
End Sub
Sub findtable(strTable As String)
'parse out string
Dim lStart As Long
Dim lStop As Long
lStart = InStr(1, strTable, "<table class=""tracker"">")
lStop = InStr(1, strTable, "</table>")
Debug.Print Mid(strTable, lStart, lStop - lStart + 1)
'MsgBox Mid(strTable, lStart, lStop - lStart + 1) 'need ESC
End Sub

If it was xml parseable it would have just been something like this

Sub test4()
Dim xmlDoc As New MSXML2.DOMDocument40
Dim objNodeList As IXMLDOMNodeList
Dim i As Long
xmlDoc.async = False
xmlDoc.Load 
("http://www.webservicex.net/stockquote.asmx/GetQuote?symbol=msft")
    If xmlDoc.parseError.errorCode <> 0 Then
                   Debug.Print " Reason: " & xmlDoc.parseError.reason
                   Debug.Print " Line: " & xmlDoc.parseError.Line
                    Debug.Print " Position: " & xmlDoc.parseError.linepos
            End If
Set objNodeList = xmlDoc.getElementsByTagName("*")
Debug.Print objNodeList.length
Debug.Print xmlDoc.xml
For i = 0 To (objNodeList.length - 1)
  MsgBox (objNodeList.Item(i).xml)
Next
End Sub

Gustav Brock wrote:

>Hi John
>
>Really? Thank you.
>
>I just wondered ... someone must have been doing something like this. There's so much info out there in lists and tables on web pages. Only a minor part has been transferred to web-services.
>
>/gustav
>
>  
>
>>>>jwcolby at ColbyConsulting.com 04-04-2006 18:22:02 >>>
>>>>        
>>>>
>Wow, that is cool. 
>
>
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada