I don't know if you will ever get this message. The microsoft website has
been broken for a long time. the website is not sending out emails when
responses are posted.

There are at least 4 different websites that share postings.
Microsoft
MSN (a 2nd microsft website)
Google
TheCodeCage.

I've switched over to using the CodeCage. I use to be able to respond at
TheCodeCage and the message would appear at microsoft. About a week ago
microsoft stopped posting responses made at the TheCodeCage as well as the
previous problem of sending out emails.

I regularly check message at the TheCodeCage.com. If you need to contact me
put Joel in the title of the message and I should see it.

"Alpineman2" wrote:



"joel" wrote:


Try these changes. I'm only getting the firwst page of results. You
may get multiple people for each search request.

Sub YellowPageSearch()
'This project includes references to "Microsoft Internet Controls" and
'"Microsoft HTML Object Library"

'Variable declarations
Dim appIE As New InternetExplorer
Dim myURL As String
Dim myDoc As HTMLDocument
Dim strSearch As String
Dim newHour As Variant
Dim newMinute As Variant
Dim newSecond As Variant
Dim waitTime As Variant
Dim cn As Range
Dim cf As Range
Dim cc As Range
Dim cs As Range
'Dim cz As Range

'On Error GoTo errHandler

'Set starting range (first cell of data)
Set cn = Sheets("Sheet1").Range("b2")
Set cf = Sheets("Sheet1").Range("c2")
Set cc = Sheets("Sheet1").Range("d2")
Set cs = Sheets("Sheet1").Range("e2")
'Set cz = Sheets("Sheet1").Range("f2")

'Set starting URL and search string
myURL = "http://www.yellowpages.com/findaperson"

'loop through list of data
Do While cn.Value < vbNullString

'Make IE navigate to the URL and make browser visible
appIE.Navigate myURL
appIE.Visible = True

'Wait for the page to load
Do While appIE.Busy Or _
appIE.readyState < READYSTATE_COMPLETE

DoEvents
Loop

'Set IE document into object

Set myDoc = appIE.document


'Enter search string on form
myDoc.forms(0).qn.Value = cn.Value
myDoc.forms(0).qf.Value = cf.Value
myDoc.forms(0).qc.Value = cc.Value
myDoc.forms(0).qs.Value = cs.Value
'myDoc.forms(0).qz.Value = cz.Value

'Submit form
myDoc.forms(0).submit

'Wait for the page to load
Do While appIE.Busy Or _
appIE.readyState < READYSTATE_COMPLETE

DoEvents
Loop

Set myDoc = appIE.document

'uncomment line for debugging
'Call dump(myDoc)

Found_Results = False
RowCount = 0

For Each itm In myDoc.all

If itm.tagName = "TABLE" And _
itm.className = "resultTable" Then

Found_Results = True
DIV_Count = 0
RowCount = RowCount + 1
End If
If Found_Results = True Then
If itm.tagName = "DIV" Then
DIV_Count = DIV_Count + 1

With Sheets("Sheet2")
Select Case DIV_Count
Case 1
FullName = itm.innerText
.Range("A" & RowCount) = FullName
Case 3
Address = itm.innerText
.Range("B" & RowCount) = Address
Case 4
PhoneNumber = itm.innerText
.Range("C" & RowCount) = PhoneNumber


End Select
End With
End If
End If

Next itm

Set s = Nothing

'waitTime = Now + TimeValue("00:00:05")
'Application.Wait waitTime
'appIE.Refresh

Set cn = cn.Offset(1, 0)
Set cf = cf.Offset(1, 0)
Set cc = cc.Offset(1, 0)
Set cs = cs.Offset(1, 0)
'Set cz = cz.Offset(1, 0)
Loop

Set appIE = Nothing
End Sub
Sub dump(myDoc)

With Sheets("sheet3")
RowCount = 1
For Each itm In myDoc.all
.Range("A" & RowCount) = itm.tagName
.Range("B" & RowCount) = itm.className
.Range("C" & RowCount) = itm.ID
.Range("D" & RowCount) = Left(itm.innerText, 1024)


RowCount = RowCount + 1
Next itm
End With

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=152149

Microsoft Office Help


Hi Joel,

I looked back at the post and noticed that you added something back about 1
week ago, however, am not sure if the code is different. Anyhow thanks again.

Brice