Data Extraction for Multiple Tables

[DrMingle]

My objective: I want to be able to place a first and last name combination into code (in this example Alison Smith) and see if the person is recognized by the site. If "yes", I want to download the information to the active spreadsheet. If "no", then what ever the result (i.e. nothing found, etc) can populate on the spreadsheet.

The below code is pulling some info, but not all.

Any help would be appreciated.


Code:

Sub AZMD()
 
    Dim URL As String
    Dim IE As Object
    Dim lastName As String, firstName As String, start As Long
    Dim rowOffset As Long
 
    Sheet1.Cells.ClearContents
    rowOffset = 0
 
    URL = "[URL unfurl="true"]http://azmd.gov/glsuiteweb/clients/a...ionSearch.aspx"[/URL]
 
    Set IE = CreateObject("InternetExplorer.Application")
 
    tbLastName = "smith"
    tbFirstName = "alison"
    start = 1
 
    While start < 101
        With IE
            .Visible = False
            .navigate URL & "?tbLastName=" & tbLastName & "&tbFirstName=" & tbFirstName & "&start=" & start
             While .Busy Or .readyState <> 4: DoEvents: Wend
            Extract_HTML_Table .document, 5, Sheet1.Range("A1").Offset(rowOffset, 0)
        End With
        start = start + 20  'Next 20 results
        rowOffset = rowOffset + 20
    Wend
End Sub
 
Private Sub Extract_HTML_Table(document As Object, tableNumber As Integer, destination As Range)
    'Extract data in rows and columns from a HTML table and put the data starting at the specified destination
 
    Dim tables As Object
    Dim table As Object
    Dim row As Object, cell As Object
    Dim nrow As Long, ncol As Long
 
    Set tables = document.getElementsByTagName("TABLE")
 
    If tableNumber <= tables.Length Then
 
        'Get the tableNumber'th table
 
        Set table = tables(tableNumber - 1)
        'Fill rows and columns starting at the destination range
 
        nrow = 0
        For Each row In table.Rows
            ncol = 0
            If row.RowIndex <> 0 Then    'ignore the first row because it contains the column headings
                For Each cell In row.Cells
                    'Debug.Print cell.innerText
                    destination.Offset(nrow, ncol).Value = cell.innerText
                    ncol = ncol + 1
                Next
                nrow = nrow + 1
            End If
        Next
 
    Else
 
        MsgBox "Unable to retrieve table number " & tableNumber & " because " & vbNewLine & _
            document.URL & " contains only " & tables.Length & " tables"
 
    End If
 
End Sub

 

[SkipVought]

Hi,

Some not all.

Please explain.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[DrMingle]

Skip:

I actually am able to get different results by changing the line:

Extract_HTML_Table .document, 5, Sheet1.Range("A1").Offset

**by replacing the number 5 with any numbers 1 - 4.

Is there away to pull down multiple HTML tables instead of individually?
1 = schooling
2 = location
3 = professionals name
etc...

 

[DrMingle]

This is complete:

http://www.mrexcel.com/forum/showthread.php?p=2301935&posted=1#post2301935

Thanks for your help.