How to import data from a website using VBA

[Seth Schrock]

I'm creating a database that will pull some data from a website and then do the necessary manipulations to it. The BE of the database is SQL Server with an Access FE. I have gotten as far as being able to pull the source code from the website and then extract just the HTML table. I'm now stuck with the HTML table code stored in a string variable and I don't know how to proceed from here. I could use the InStr(), and Mid() functions to get the values out of the table and then write them to a table, but I was hoping that I could just import the data so that I wouldn't have to write as much code that gets difficult to figure out because of nested InStr() and Mid() functions.

[Rabbit]

Rather than a bunch of mid and instr methods, I would use split or regular expressions. I don't think there's a native function to inport html data.

[ADezii]

How about Posting a sample of the Data contained in your String Variable.

[Hennepin]

I wrote this code several years ago to down load baseball stats from espn. It reads one character at a time.
saves the output into a comma seperated file.
You can tweak it to your needs.

Have a reference to microsoft scripting runtime for file system object.

Option Compare Database
Option Explicit

Enum RdProcess
    tableout
    tablein
    tagin
    tagout
    fieldin
    fieldout
    rowskip
    Readstart
    Readend
End Enum


Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
  "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
    szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
  
Public Function DownloadFilefromWeb(Url As String, strSavePath As String) As Boolean
    Dim ret As Long
    ret = URLDownloadToFile(0, Url, strSavePath, 0, 0)
    If ret = 0 Then
        DownloadFilefromWeb = True
    Else
        DownloadFilefromWeb = False
    End If
End Function

Public Sub dofiles()
    Dim fso As FileSystemObject, tso As TextStream, tsoi As TextStream, i As Integer, spath As String, Url As String
    Dim strSavePath As String
    spath = "E:\strato\"
    Set fso = CreateObject("Scripting.FileSystemObject")
        
    Set tso = fso.OpenTextFile(spath & "newpit.txt", ForWriting, True, 0)
    Url = "http://espn.go.com/mlb/stats/pitching/_/qualified/false/order/false"
    strSavePath = spath & "temp_pit_file.txt"
    i = 1
    Do While DownloadFilefromWeb(Url, strSavePath)
        Set tsoi = fso.OpenTextFile(strSavePath, ForReading, False, 0)
        If get_stats_table(tso, tsoi) Then
            tsoi.Close
            Exit Do
        End If
        tsoi.Close
        Url = "http://espn.go.com/mlb/stats/pitching/_/count/" & i & "/qualified/false/order/false"
        i = i + 40 'forty players per page
    Loop
    tso.Close
    
    Set tso = fso.OpenTextFile(spath & "newbat.txt", ForWriting, True, 0)
    Url = "http://espn.go.com/mlb/stats/batting/_/qualified/false"
    strSavePath = spath & "temp_bat_file.txt"
    i = 1
    Do While DownloadFilefromWeb(Url, strSavePath)
        Set tsoi = fso.OpenTextFile(strSavePath, ForReading, False, 0)
        If get_stats_table(tso, tsoi) Then
            tsoi.Close
            Exit Do
        End If
        tsoi.Close
        Url = "http://espn.go.com/mlb/stats/batting/_/count/" & i & "/qualified/false"
        i = i + 40
    Loop

    tso.Close
End Sub
Public Function get_stats_table(tso As TextStream, tsoi As TextStream) As Boolean
    Dim i As Integer, s As String
    Dim tagVal  As String, fval As String
    Dim stat As RdProcess, FoundTable As Boolean, readtable As Boolean, decount As Integer
    
    FoundTable = False
    stat = tableout

    Do
        s = tsoi.Read(1)
        Select Case stat
        Case tableout
            tagVal = Right(tagVal, 5) + s
            If tagVal = "<Table" Then stat = tablein
        Case tablein
            If s = "<" Then ' start reading a tag else ignor the stuff
                stat = tagin
                tagVal = "<"
            End If
        Case tagin
            tagVal = tagVal + s
            If s = ">" Then
                stat = Handle_the_Tag(tagVal, fval, tso, FoundTable, decount)
                tagVal = ""
                If stat = Readend Then
                    Exit Do
                End If
            End If
        Case tagout ' decifer the tag
            If s = "<" Then
                stat = tagin
                tagVal = s
            End If
        Case fieldin
            If s = "<" Then
                tagVal = "<"
                stat = tagin
            Else
                fval = fval + s
            End If
        Case rowskip
            tagVal = Right(tagVal, 4) + s
            If tagVal = "</tr>" Then stat = tagout
        Case Readend
            Exit Do
        End Select
    Loop Until tsoi.AtEndOfStream
      '  tso.Write (s)
    get_stats_table = CBool(decount < 40)
End Function
'<table     </table>
'<td        </td>             <td align="left">WAS</td>
'<tr        </tr>
Function Handle_the_Tag(tagVal As String, fval As String, tso As TextStream, FoundTable As Boolean, decount As Integer) As RdProcess
    Dim p As Integer
    If tagVal Like "</td>" Then 'write  comma space
        If FoundTable Then
            tso.Write fval & ", "
        Else
            If fval = "Sortable Batting" Then
                FoundTable = True
            End If
            If fval = "Sortable Pitching" Then
                FoundTable = True
            End If
        End If
        fval = ""
        Handle_the_Tag = tagout
    ElseIf tagVal Like "<td*>" Then
        fval = ""
        Handle_the_Tag = fieldin
    ElseIf tagVal = "</table>" Then
        If FoundTable Then
            Handle_the_Tag = Readend        'done reading file
        Else
            Handle_the_Tag = tableout
        End If
    ElseIf tagVal = "</tr>" Then 'write newline
        If FoundTable Then tso.Write vbCrLf
        Handle_the_Tag = tagout
    ElseIf tagVal Like "<tr class=""colhead""*>" Then
        Handle_the_Tag = rowskip
    ElseIf tagVal Like "<a href=*" Then   'get Id and write id comma space
        If FoundTable Then
            p = InStrRev(tagVal, "id/") '<a href="/mlb/players/profile?playerId=4949"> Willie Harris</a>
            '<a href="http://espn.go.com/mlb/player/_/id/6261/scott-baker">   Scott Baker
            fval = "" & val(Mid(tagVal, p + 3))
            decount = decount + 1
            p = InStrRev(tagVal, "/")
            fval = fval & ", " & Mid(tagVal, p + 1)
            fval = Replace(fval, """>", "")
            
            tso.Write fval & ", "
            fval = ""
            Handle_the_Tag = fieldin
        Else
            Handle_the_Tag = tagout
        End If
    Else
        Handle_the_Tag = fieldin
    End If
End Function

[Seth Schrock]

<table class="table1" cellpadding="0" cellspacing="0" width="185">
<colgroup class="stdColgroup">
<col span="1" class="hdrCol"><col span="4" class="stdCol">
</colgroup>
<thead>
   <tr><th colspan="5"><a href="/pmms/" target="_top">Freddie Mac's Primary Mortgage Market Survey</a>&reg;</th></tr>
   <tr class="theadSub"><td>&nbsp;</td><td>30YR FRM</td><td>15YR FRM</td><td>5YR ARM</td><td>1YR ARM</td></tr>
</thead>    
 
<tfoot>
   <tr><td colspan="5">Copyright 2013, <a href="http://www.freddiemac.com/" target="_top">Freddie Mac</a>. 
   Averages are for conforming mortgages with 20% down.</td></tr>
</tfoot>
<tr><th>Avg.</th><td>4.32 </td><td>3.37 </td> 
    <td>3.07 </td><td>2.63 </td></tr>
<tr><th>Fees&nbsp;& Points</th><td>0.7 </td><td>0.7 </td>
    <td>0.5 </td><td>0.4 </td></tr>

</table>

That is the HTML Table code. I know that I can import an HTML document using the import wizard in Access 2010, so I suppose that I could save the text as a file and then import the file, but I don't know how to do those steps either.

I will have to look at the Split and Regular functions to see how I can use them as I'm not familiar with those.

[ADezii]

Within a couple of minutes I was able to extract most of the Primary Data as such:

Dim strHTML As String
Dim varSplit As Variant
Dim intCtr As Integer

strHTML = "<table class='table1' cellpadding='0' cellspacing='0' width='185'>" & _
          "<colgroup class='stdColgroup'>" & _
          "<col span='1' class='hdrCol'><col span='4' class='stdCol'>" & _
          "</colgroup>" & _
          "<thead>" & _
          "<tr><th colspan='5'><a href='/pmms/' target='_top'>Freddie Mac's Primary Mortgage Market Survey</a>&reg;</th></tr>" & _
          "<tr class='theadSub'><td>&nbsp;</td><td>30YR FRM</td><td>15YR FRM</td><td>5YR ARM</td><td>1YR ARM</td></tr>" & _
          "</thead>" & _
          "<tfoot>" & _
          "<tr><td colspan='5'>Copyright 2013, <a href='http://www.freddiemac.com/' target='_top'>Freddie Mac</a>." & _
          "Averages are for conforming mortgages with 20% down.</td></tr>" & _
          "</tfoot>" & _
          "<tr><th>Avg.</th><td>4.32 </td><td>3.37 </td>" & _
          "<td>3.07 </td><td>2.63 </td></tr>" & _
          "<tr><th>Fees&nbsp;& Points</th><td>0.7 </td><td>0.7 </td>" & _
          "<td>0.5 </td><td>0.4 </td></tr>" & _
          "</table>"
          
varSplit = Split(strHTML, "<td>")

For intCtr = LBound(varSplit) To UBound(varSplit)
  Debug.Print Split(varSplit(intCtr), " ")(0)
Next

OUTPUT:

<table
&nbsp;</td>
30YR
15YR
5YR
1YR
4.32
3.37
3.07
2.63
0.7
0.7
0.5
0.4

[Seth Schrock]

I appreciate all the help. Unfortunately, I have been pulled into another task right now, but hopefully I will be able to test all of your solutions in the next few days. I will post back the results and if I need any help. Thanks again.

[Seth Schrock]

I have finally gotten back to this. Thanks ADezii. It worked perfectly and it is extremely easy to implement.

[ADezii]

You are quite weldcome, Seth.