Using Excel to Fill Out Form - Getting error on last name

D

drmingle

Board Regular
Joined
Oct 5, 2009
Messages
229
Thank you for your help.

I need to be able to pull up the below site and fill out the form. Idealy extracting the output generated.

Below is what I have so far:
Code: 
Sub SSI_MAcRO()
'
' SSI_MAcRO Macro
'
'_PULL UP FORM
    Dim Ie
    Set Ie = CreateObject("InternetExplorer.application")
    Ie.Visible = True
    Ie.navigate ("[URL]http://ssdi.rootsweb.ancestry.com/cgi-bin/ssdi.cgi[/URL]")
    Do
        If Ie.readyState = 4 Then
            Ie.Visible = True
            Exit Do
        Else
            DoEvents
        End If
    Loop
'USE VIEW SOURCE TO GET FORM ELEMENT IDS
    Ie.document.forms(1).all("lastname").Value = Range("I11")
    Ie.document.forms(1).all("firstname").Value = Range("I14")
    Ie.document.forms(1).submit
'
End Sub

I am having a problem with the form elements:

HTML: 
******** type="text/javascript" src="http://images.rootsweb.ancestry.com/js/rwhr.js">*********>
******** type="text/javascript" src="http://images.rootsweb.ancestry.com/js/oas_ssdi.js">*********>
******** type="text/javascript" language="javascript1.1" src="http://images.rootsweb.ancestry.com/js/o2.js">*********>
******** type="text/javascript" src="http://images.rootsweb.ancestry.com/js/o3.js">*********>


******** type="text/javascript">writeHeader('760px','Searches');*********>



******** type="text/javascript">OAS_AD('Top');*********>










Social Security Death Index (SSDI)

86,272,034 








Search the Social Security Death Index by entering one or more fields in the form and clicking on the 
"submit" button. Keep in mind that the more fields you fill in the more restricted your results 
will be (and you may even eliminate the record you are seeking).

 




SSDI 
Tutorial





 • Missing Entries

 • Reporting Inaccuracies

 • Definitions, Search Tips

 • Full Tutorial








 


RootsWeb's 
Guide to Tracing Family Trees







U. S. Social Security Death Index (SSDI) and 
Railroad Retirement Board Records

























Last Name


 ExactSoundexMetaphone





First Name







Middle Name or Initial







Social Security Number







  


  






 


















******** type="text/javascript">writeFooter();*********>
******** type="text/javascript">
var s_pageName="SSDI Main Page - //ssdi/index.html";
*********>
******** type="text/javascript" src="http://img.rootsweb.com/omniture/omniture_tracking.js">*********>
******** type="text/javascript" src="http://id.ancestry.com/html/script/TSpacer.js">*********>
 
Sort by date Sort by votes
Interesting....Your piece works perfectly...I am trying to merge another snippet for the 'getonetable'...not having any luck with the below code:

Code: 
Sub SSDI_results()
 
    Dim URL As String
    Dim IE As Object
    Dim lastName As String, firstName As String, start As Long
 
    URL = "[URL]http://ssdi.rootsweb.ancestry.com/cgi-bin/ssdi.cgi[/URL]"
 
    Set IE = CreateObject("InternetExplorer.Application")
 
    lastName = "JOHNSON"
    firstName = "EARL"
 
    start = 1
    While start < 101
        With IE
            .Visible = True
            .navigate URL & "?lastname=" & lastName & "&firstname=" & firstName & "&start=" & start
            While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        End With
        start = start + 20  'Next 20 results
    Wend
 
With IE       
        Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
        Set doc = IE.Document
        GetOneTable doc, 1
        .Quit
    End With
 
End Sub
Sub GetOneTable(d, n)
' d is the document
' n is the table to extract
Dim e As Object ' the elements of the document
Dim t As Object ' the table required
Dim r As Object ' the rows of the table
Dim c As Object ' the cells of the rows.
Dim I As Long
Dim J As Long
    For Each e In d.all
        If e.nodename = "TABLE" Then
            J = J + 1
        End If
        If J = n Then
            Set t = e
 
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set rng = Range("A" & nextrow)
            For Each r In t.Rows
                For Each c In r.Cells
                    rng.Value = c.innertext
                    Set rng = rng.Offset(, 1)
                    I = I + 1
                Next c
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -I)
                I = 0
            Next r
            Exit For
        End If
 
    Next e
 
End Sub
 
Upvote 0
How is the code not working and what do you want it to do?

I wrote that code, well the GetOneTable bit anyway, quite some time ago and it's certainly not perfect.:)

It's pretty crude, particularly the first loop - I think I used that because I hadn't yet discovered GetElementByID/Name.
 
Upvote 0
Here is what I have...so far...
  • Form fills out
  • Results post appropriately
  • Download of background occurs
I am still not able to download the individuals information into a spreadsheeet...

Code: 
Sub test()
Set IE = CreateObject("internetexplorer.Application")
IE.Visible = False
IE.Navigate "[URL]http://ssdi.rootsweb.ancestry.com/[/URL]"
Do While IE.Busy And Not IE.ReadyState = 4
    lastName = "JOHNSON"
    middleName = ""
    firstName = "EARL"
DoEvents
Loop
GetAllTables IE.document
End Sub
Sub GetAllTables(d)
    For Each e In d.all
        If e.nodename = "TABLE" Then
            Set t = e
 
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set rng = Range("B" & nextrow)
            rng.Offset(, -1) = "Table " & tabno
            For Each r In t.Rows
                For Each c In r.Cells
                    rng.Value = c.innertext
                    Set rng = rng.Offset(, 1)
                    I = I + 1
                Next c
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -I)
                I = 0
            Next r
        End If
    Next e
End Sub
 
Upvote 0
I'm getting a bit confused, you now seem to be using GetAllTables which is another sub I think a small bird with a brightly coloured beak wrote.

Can you explain in words what you want to do?:)
 
Upvote 0
Try this:
Code: 
Sub SSDI_results()
    
    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 = "http://ssdi.rootsweb.ancestry.com/cgi-bin/ssdi.cgi"
    
    Set IE = CreateObject("InternetExplorer.Application")
    
    lastName = "JOHNSON"
    firstName = "EARL"
    start = 1
    
    While start < 101
        With IE
            .Visible = True
            .navigate URL & "?lastname=" & lastName & "&firstname=" & firstName & "&start=" & start
            While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
            Extract_HTML_Table .document, 9, 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
I also tried a web query on http://ssdi.rootsweb.ancestry.com/cgi-bin/ssdi.cgi?lastname=JOHNSON&firstname=EARL&start=1, and although you can select the results table, no data is retrieved - not sure why.
 
Last edited:
Upvote 0
My Excel is choking on the following line of code:

Code: 
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend

Any ideas?
 
Upvote 0
Could you please tell us what you want to do and what the exact code that you are using is causing the problem?

It might also help if you explained what you mean by 'choking'

Are you getting errors? Unexpected results?

I've tried accessing the website a few times using VBA, it seems the problem might be with some sort of pop-up for another site.

That could be disrupting references to IE and the website.

Doing this sort of thing can sometimes not be straightforward - a lot of it depends on the design of the page and the code behind it.:)
 
Upvote 0
O.k...
This code works sometimes and sometimes it doesn't. The problem as I see it is the HTML form/table is dynamic and creating problems....depending on what the state of the form/table are problems are created.

When the stars align the output is great...

Can anybody help with overcoming the dynamic nature of the HTML form/tables?

Code: 
Sub SSDI_results()
 
    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]http://ssdi.rootsweb.ancestry.com/cgi-bin/ssdi.cgi[/URL]"
 
    Set IE = CreateObject("InternetExplorer.Application")
 
    lastName = "JOHNSON"
    firstName = "EARL"
    start = 1
 
    While start < 101
        With IE
            .Visible = False
            .navigate URL & "?lastname=" & lastName & "&firstname=" & firstName & "&start=" & start
             While .Busy Or .readyState <> 4: DoEvents: Wend
            Extract_HTML_Table .document, 9, Sheet1.Range("A1").Offset(rowOffset, 0)
        End With
        start = start + 20  'Next 20 results
        rowOffset = rowOffset + 20
    Wend
 
'Parse Name
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("A:A").Select
    Selection.TextToColumns destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
    ActiveWindow.SmallScroll Down:=-24
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
 
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
 
Upvote 0
This code works great when it works...but I am thinking there is either a dynamic table or form because it doesn't seem very stable (somone mentioned a possible pop-up)...when I do get the output it is perfect...

The problem is on the extract, not on the form-fill or the output in HTML...simply on the extract...

Any help would be appreciated...

Code: 
Sub SSDI_results()
 
    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]http://ssdi.rootsweb.ancestry.com/cgi-bin/ssdi.cgi[/URL]"
 
    Set IE = CreateObject("InternetExplorer.Application")
 
    lastName = "JOHNSON"
    firstName = "EARL"
    start = 1
 
    While start < 101
        With IE
            .Visible = False
            .navigate URL & "?lastname=" & lastName & "&firstname=" & firstName & "&start=" & start
             While .Busy Or .readyState <> 4: DoEvents: Wend
            Extract_HTML_Table .document, 9, Sheet1.Range("A1").Offset(rowOffset, 0)
        End With
        start = start + 20  'Next 20 results
        rowOffset = rowOffset + 20
    Wend
 
'Parse Name
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("A:A").Select
    Selection.TextToColumns destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
    ActiveWindow.SmallScroll Down:=-24
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
 
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
Sub Macro3()
'
' Macro3 Macro
' Macro recorded 4/22/2010 by DRMingle
'
'Parse Name
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("A:A").Select
    Selection.TextToColumns destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
    ActiveWindow.SmallScroll Down:=-24
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
 
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Auto Login to intranet
Replies
0
Views
942
Roy03111984
R
D
  • Question Question
VBA - IE automation text field input RTE 438
2 3
Replies
20
Views
22K
Norie
Norie
A
  • Question Question
How do I Submit/Click Button on IE using automation, if no id present, and all submitforms have the same name?
Replies
1
Views
2K
antlz
A
S
  • Question Question
Excel VBA to Send GET (or POST) to IE Page
Replies
1
Views
2K
Smitty
Smitty
S
  • Locked
  • Question Question
Excel VBA to Send GET (or POST) to IE Page
Replies
0
Views
2K
SerenityNetworks
S

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top