ExcelBanter - Run-Time Error

I am running the following code. It runs down a list of rows retrieving data
from the web for me. After it cycles through 92 rows, I receive the
following error:

======
Run-time error '-2147417848 (80010108)':

Automation error
The object invoked has disconnected from its clients.
======

Once I get this error, I have to shut completely down and can only recover
from my last saved point. This always happens after the exact same number of
rows, no matter how the data is sorted.

Any help would be highly appreciated. Here is my code:
------------
Sub Dex001()
'This subprocedure looks up phone book information:

Dim strLast As String
Dim strFirst As String
'Dim bSimilarNames As Boolean 'Smart
Dim strCity As String
Dim strState As String
'Dim bSurroundingAreas As Boolean 'Metro
Dim DesiredRow As Long
Dim PositionOfSpace As Long

'Init Vars:
'DesiredRow =
Workbooks(Application.ActiveWorkbook.Name).Sheets( "Dex").Range("D6")
DesiredRow = Application.ActiveCell.Row

strLast =
Workbooks(Application.ActiveWorkbook.Name).Sheets( "DexData").Range("A" &
DesiredRow)
strFirst =
Workbooks(Application.ActiveWorkbook.Name).Sheets( "DexData").Range("B" &
DesiredRow)
'bSimilarNames =
Workbooks(Application.ActiveWorkbook.Name).Sheets( "DexData").Range("B" &
DesiredRow)
strCity =
Workbooks(Application.ActiveWorkbook.Name).Sheets( "DexData").Range("C" &
DesiredRow)

'Replace spaces with "+" in the City name
PositionOfSpace = InStr(1, strCity, " ")
If PositionOfSpace 0 Then
strCity = Left(strCity, PositionOfSpace - 1) & "+" & Right(strCity,
Len(strCity) - PositionOfSpace)
End If

strState =
Workbooks(Application.ActiveWorkbook.Name).Sheets( "DexData").Range("D" &
DesiredRow)
'bSurroundingAreas =
Workbooks(Application.ActiveWorkbook.Name).Sheets( "DexData").Range("B" &
DesiredRow)

If strLast < "" Or strFirst < "" Then

'Start by clearing the data area:
Columns("I:J").Select
Selection.Delete Shift:=xlToLeft

'Now use the Web Query to fetch the data:
With
ActiveSheet.QueryTables.Add(Connection:="URL;http://www.dexonline.com/servlet/ActionServlet?pid=rresults&form=ResWhite&from=&PRE VIOUS_PAGE=rsearch&lastname="
& strLast & "&firstname=" & strFirst & "&smart=1&city=" & strCity & "&state="
& strState & "&Search+The+Listings.x=47&Search+The+Listings.y=1 3",
Destination:=Sheets("DexData").Range("I1"))
'With
ActiveSheet.QueryTables.Add(Connection:="URL;http://www.dexonline.com/servlet/ActionServlet?pid=rresults&form=ResWhite&from=&PRE VIOUS_PAGE=rsearch&lastname="
& strLast & "&firstname=" & strFirst & "&smart=1&city=" & strCity & "&state="
& strState & "&metro=1&Search+The+Listings.x=47&Search+The+List ings.y=13",
Destination:=Sheets("DexData").Range("I1"))

.Name =
"ActionServlet?pid=rresults&form=ResWhite&from=&PR EVIOUS_PAGE=rsearch&lastname="
& strLast & "&firstname=" & strFirst & "&smart=1&city=" & strCity & "&state="
& strState & "&Search+The+Listings.x=47&Search+The+Listings "
'.Name =
"ActionServlet?pid=rresults&form=ResWhite&from=&PR EVIOUS_PAGE=rsearch&lastname="
& strLast & "&firstname=" & strFirst & "&smart=1&city=" & strCity & "&state="
& strState & "&metro=1&Search+The+Listings.x=47&Search+The+List ings"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False 'was True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With

Else

MsgBox "Please select the row you are trying to update before clicking
the button."

End If

Range("A" & DesiredRow).Select

End Sub

Sub CompleteProcess()

Dim DesiredRow As Long
DesiredRow = Application.ActiveCell.Row

'Setup a brief pause:
'Dim newHour, newMinute, newSecond, waitTime
'newHour = Hour(Now())
'newMinute = Minute(Now())
'newSecond = Second(Now()) + 10
'waitTime = TimeSerial(newHour, newMinute, newSecond)
'Application.Wait waitTime

'Now beep 3 times:
'Dim I
'For I = 1 To 200 ' Loop X times.
' Beep ' Sound a tone.
'Next I

'Paste the values where they belong
Sheets("DexData").Select
Range("I2").Select
Selection.Copy
Range("E" & DesiredRow).Select
ActiveSheet.Paste
Range("J1").Select
Application.CutCopyMode = False
Selection.Copy
Range("F" & DesiredRow).Select
ActiveSheet.Paste
Columns("E:F").Select
Columns("E:F").EntireColumn.AutoFit
Columns("I:J").Select
Selection.Delete Shift:=xlToLeft

'Clear the garbage left behind
'Columns("I:J").Select
'Selection.Delete Shift:=xlToLeft
Range("A" & DesiredRow).Select

End Sub

ActionServlet?pid=rresults&form=ResWhite&from=&PRE VIOUS_PAGE=rsearch&lastname=webster&firstname=byra n&city=holladay&state=UT&metro=1&Search+The+Listin gs.x=0&Search+The+Listings.y=0

Public Sub Test_IESendkeys()
Dim i As Long
Dim ie As Object

Set ie = CreateObject("InternetExplorer.Application")
With ie

.Visible = True

.navigate "http://www.funny.com"
.resizable = True
End With

Application.Wait (Now + TimeValue("0:00:10"))

'App.Activate "Microsoft Internet Explorer"
For i = 1 To 15
SendKeys "{TAB}"
Next i

SendKeys "test"
'SendKeys "~"
End Sub

Set oIE = New InternetExplorer
oIE.Visible = True
oIE.Navigate Range("sURL")
Do: DoEvents: Loop Until oIE.ReadyState = READYSTATE_COMPLETE

Set oForm = oIE.Document.forms(0)
oForm("name1").Value = "Value1"
oForm("name2").Value = "Value2"
oForm("submitname").Click
Do: DoEvents: Loop While oIE.Busy
Do: DoEvents: Loop Until oIE.ReadyState = READYSTATE_COMPLETE

Set oForm = oIE.Document.forms(0)
oForm("cancelname").Click

---------

Thanks,
Bryan