Easy - Internet Question Page Source

I would like the code required to read the following page and place specific data into some text boxes.

Site: http://www.experts-exchange.com/viewMember.jsp?mid=1050957

I would like my Total Questions Asked to be in text1 and Total Answered To be in Text2.

I have previously asked a question on reading source, but I cannot understand how to do this.

thanks
gregman22Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

zzzzzoocCommented:
I've taken the time to do an example but no documentation. Since it's "easy" you should be able to understand it.

Include a reference to: "Microsoft HTML Object Library" .. You could additionally download the source and parse it for what you're looking for but I just did a simpler loop.


Private boolClose As Boolean
Private Sub Form_Load()
    Dim hDoc1 As New HTMLDocument, hDoc2 As New HTMLDocument
    Dim hColl As IHTMLElementCollection, hCell As HTMLTableCell
    Dim intWhich As Integer
    Me.Visible = True
    Set hDoc1 = hDoc2.createDocumentFromUrl("http://www.experts-exchange.com/viewMember.jsp?mid=1050957", "none")
    Do Until hDoc1.readyState = "complete"
        'This loop will repeat forever if it failed so:
        If boolClose = True Then Exit Sub
        DoEvents
    Loop
    Set hColl = hDoc1.All.tags("td")
    For Each hCell In hColl
        If intWhich = 1 Then
            Text1.Text = hCell.outerText
            intWhich = 0
        ElseIf intWhich = 2 Then
            Text2.Text = hCell.outerText
            intWhich = 0
        End If
        If hCell.outerText = "Questions Asked:" Then
            intWhich = 1
        ElseIf hCell.outerText = "Questions Answered:" Then
            intWhich = 2
        End If
    Next hCell
    Set hDoc1 = Nothing
    Set hDoc2 = Nothing
    Set hColl = Nothing
    Set hCell = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
    boolClose = True
End Sub
vinnyd79Commented:
you could use a web browser control:

Private Sub Command1_Click()
WebBrowser1.Navigate2 "http://www.experts-exchange.com/viewMember.jsp?mid=1050957"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim Asked() As String, Answered() As String
Asked = Split(WebBrowser1.Document.body.innertext, "Questions Asked:")
Answered = Split(WebBrowser1.Document.body.innertext, "Questions Answered:")
Text1.Text = Left$(Asked(1), InStr(Asked(1), vbCrLf) - 1)
Text2.Text = Left$(Answered(1), InStr(Answered(1), vbCrLf) - 1)

End Sub
gregman22Author Commented:
zzzzzooc,

I pasted your code and put 2 text boxes on my form. I also referenced the library. I ran the program and nothing happened.

The text in the text box's did not change. Any ideas?
Fundamentals of JavaScript

Learn the fundamentals of the popular programming language JavaScript so that you can explore the realm of web development.

gregman22Author Commented:
vinnyd79,

when i run your code i get the error "Subscript out of range" for Text1.Text = Left$(Asked(1), InStr(Asked(1), vbCrLf) - 1)

?
gregman22Author Commented:
I really need help so points are increased.
vinnyd79Commented:
The above example works fine for me. Did you modify anything?
gregman22Author Commented:
No i didn't.

All I do is place the web browser control on my form and a command button.

It gave that error.
gregman22Author Commented:
vinnyd79,

Sorry, It worked that time. (i'll give you points for that).

I really don't want to use the Web Browser Control. Is there another method you can come up with.

Points increased.

thanks
vinnyd79Commented:
Try putting this on a form with a command button and 2 textboxes:


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

Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

Private Sub Command1_Click()
Dim ff As Integer, Qask As String, Qans As String, p As Integer
ret = DownloadFile("http://www.experts-exchange.com/viewMember.jsp?mid=1050957", _
    Environ("temp") & "\TmpHtm.tmp")
ff = FreeFile
Open Environ("temp") & "\TmpHtm.tmp" For Input As #ff
Do Until EOF(ff)
Line Input #ff, Ln
If InStr(Ln, "Questions Asked:") > 0 Then
    Line Input #ff, Ln
    p = InStr(Ln, ">") + 1
    Qask = Mid$(Ln, p, InStr(Ln, "</td>") - p)
    Text1.Text = Qask
End If

If InStr(Ln, "Questions Answered:") > 0 Then
    Line Input #ff, Ln
    p = InStr(Ln, ">") + 1
    Qans = Mid$(Ln, p, InStr(Ln, "</td>") - p)
    Text2.Text = Qans
End If

Loop
Close #ff
Kill Environ("temp") & "\TmpHtm.tmp"
End Sub

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
gregman22Author Commented:
vinnyd79,

works great.

I tried to get my total "questions opened" with the following, but it doesn't work?

Why?

If InStr(Ln, "Questions Opened:") > 0 Then
   Line Input #ff, Ln
   p = InStr(Ln, ">") + 1
   Qopen = Mid$(Ln, p, InStr(Ln, "</td>") - p)
   txtOpen.Text = Qopen
End If

I copied this between the other 2 If statements

thanks
vinnyd79Commented:
What you had is fine except that on the page it is referred to as "Questions Open:" Not "Questions Opened:". So this should work:


If InStr(Ln, "Questions Open:") > 0 Then
  Line Input #ff, Ln
  p = InStr(Ln, ">") + 1
  Qopen = Mid$(Ln, p, InStr(Ln, "</td>") - p)
  txtOpen.Text = Qopen
End If

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.