I need to get data form a web page

[dglienna]

I don't know if he got it working.

[TheVader]

Nice work with the control, Rob. Although your code could use some optimization. You can do more with the Document object model than you're doing now.

For starters, you shouldn't need the Sleep command while you're waiting. The ReadyState property will perform better than Busy.

Do While WebBrowser1.ReadyState <> READYSTATE_COMPLETE
    DoEvents
Loop

You don't have to focus the textbox in order to fill in the value or to click it. Calling the Click event on it is more reliable than using SendKeys.

hInp.Value = "07800008846"
hInp.Click

Finally, you don't have to use string manipulation to extract the data from the webpage. In this case, you could enumerate all TD tags with the getElementsByTagName method, then when the innerText property of a TD element is "Manufacurer", read out the next TD tag which contains text.

If you want to learn more about the Web Browser control or the Document Object Model, read the articles in my sig.

[RobDog888]

Thanks Vad. I just put this together last night quickly, first time.

I was having trouble with the .Click of the hInp object. Was stating a type mismatch or something.
ReadyState vs Busy, didnt see that one. getElementsByTagName was giving issues too because the submit
button doesnt have a id or name. What do you do in that case?

Thanks

[dglienna]

Vader, I downloaded your browser control a long time ago, but didn't see anything in it that I saw as being able to parse information from web pages. Do you have an example of how you could programmatically interact with a page or series of web pages?
For instance, logging on to VBF and reading and or writing a Private message would be cool. And helpful. Any examples of automating would help.

[MJBNET]

a very informative thread ! like the way ya got the page on the form...
since i do this all the time for stock data i would add that using api URLDownloadToFile is prolly faster & no send keys needed...

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
 
    Public 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
    Call DownloadFile("http://www.upcdatabase.com/item.pl?upc=078000088465", "c:\test.txt")
    
    'then parse test.txt...

[RobDog888]

For instance, logging on to VBF and reading and or writing a Private message would be cool...

Dave, you should be careful. This could possibly be considered hacking the Forums - an AUP violation.

[dglienna]

Well, I was just trying to find a common site that most of us could use. I don't know how that would be hacking, as long as it was your own account, but whatever. I'd be just as happy with any site that has log on credentials.

I've only seen one instance of this that actually worked.

[bob5731]

'Add component to Microsoft HTML Object Library
'Add component Microsoft Internet Controls

'Add a command button (Command1)
'Add a web browser control to the form (WebBrowser1)
Dim hDoc 'As MSHTML.HTMLDocument
Dim hCol 'As MSHTML.IHTMLElementCollection
Dim hInp 'As MSHTML.HTMLInputElement
Dim hSub 'As MSHTML.HTMLInputButtonElement
Dim hTxt 'As MSHTML.HTMLInputTextElement

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
Dim iStart As Integer
Dim iEnd As Integer
iStart = 0
iEnd = 0
If WebBrowser1.LocationURL <> "http://www.upcdatabase.com/nocheckdigit.pl" Then
WebBrowser1.Navigate2 "http://www.upcdatabase.com/nocheckdigit.pl"
End If
Do While WebBrowser1.Busy = True
DoEvents
Sleep 500
Loop
Set hDoc = WebBrowser1.Document
Set hInp = hDoc.getElementById("upc")
hInp.focus
hInp.Value = "07800008846"
SendKeys "{ENTER}", True
Do While WebBrowser1.Busy = True
DoEvents
Sleep 500
Loop
Set hInp = Nothing
'Parse the elements and read the values of the data returned
'Set document variable = to the new results documents page
Set hDoc = WebBrowser1.Document
'Find the description:
iStart = InStr(1, hDoc.body.innerHTML, "<TD>Description</TD>") + 37
iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
'Find the Size/Weight:
iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Size/Weight</TD>") + 37
iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
'Find Manufacturer:
iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Manufacturer</TD>") + 38
iEnd = InStr(iStart, hDoc.body.innerHTML, "(<A href=")
MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
'Find the Entered/Modified:
iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Entered/Modified</TD>") + 42
iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate2 "http://www.upcdatabase.com/nocheckdigit.pl"
End Sub

Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
WebBrowser1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 450 'Make adjustment for command button
End If
End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
' Set hDoc = WebBrowser1.Document
End Sub

[RobDog888]

From post 36. you need to add this reference and control.

'Add reference to Microsoft HTML Object Library
'Add component Microsoft Internet Controls

What error are you getting?

[bob5731]

I can run moor then one time.

[RobDog888]

Come on Bob, you got to give some effort and write at least one line of code.
You didnt even state if your getting an error or what you are wanting to do?

[bob5731]

I not know vb 6.0 at all.

[RobDog888]

I think the isue is that the page is not completely loaded when the hInp object is trying to get set.
Try adding thevaders sggestion.

Do While WebBrowser1.ReadyState <> READYSTATE_COMPLETE
    DoEvents
Loop

Instead of this one.

Do While WebBrowser1.Busy = True
    DoEvents
    Sleep 500
Loop

[dglienna]

I tried his suggestions. The ready state fires too soon for the first messagebox, so I had to leave the sleep command in. I also couldn't get the .click to work either. Here is what I have to get them automatically.
And added the error trap in case you have an invalid number.

Private Sub Command1_Click()
    Dim iStart As Integer
    Dim iEnd As Integer
    Dim UPC As String
    iStart = 0
    iEnd = 0
    If WebBrowser1.LocationURL <> "http://www.upcdatabase.com/nocheckdigit.pl" Then
        WebBrowser1.Navigate2 "http://www.upcdatabase.com/nocheckdigit.pl"
    End If
    Do While WebBrowser1.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    Set hDoc = WebBrowser1.Document
    Set hInp = hDoc.getElementById("upc")
    UPC = InputBox("Enter UPC Number", , "07800008846")
    hInp.focus
    hInp.Value = UPC
    SendKeys "{ENTER}", True
    Do While WebBrowser1.ReadyState <> READYSTATE_COMPLETE
        DoEvents
        Sleep 500
    Loop
    Set hInp = Nothing
    'Parse the elements and read the values of the data returned
    'Set document variable = to the new results documents page
    On Error GoTo error_not_found
    Set hDoc = WebBrowser1.Document
    'Find the description:
    iStart = InStr(1, hDoc.body.innerHTML, "<TD>Description</TD>") + 37
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find the Size/Weight:
    iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Size/Weight</TD>") + 37
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find Manufacturer:
    iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Manufacturer</TD>") + 38
    iEnd = InStr(iStart, hDoc.body.innerHTML, "(<A href=")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find the Entered/Modified:
    iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Entered/Modified</TD>") + 42
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
error_not_found:
     On Error GoTo 0
     WebBrowser1.Navigate2 "http://www.upcdatabase.com/nocheckdigit.pl"
End Sub

[bob5731]

how do I save it in dat formet upc.dat

[TheVader]

Attached is a sample project that completely relies on the Document Object Model to extract the info from the UPC site. It's much more reliable than string parsing, and needs fewer lines too. I'll write another example to play around with VBForums, David.

Bob, why do you attempt to write an application in a programming language you don't know and obviously do not want to learn? If you want an application written for you, hire a programmer at RentACoder.com. A forum is meant to help you with programming, not to deliver complete applications for free on demand...

[dglienna]

using that, I still get an object or with block not set. I think the same thing was happening when I switched my example back to the sleep statement. The error is on the line that submits the upc number. If I hit F5, it runs, though.

That definitely seems like the correct way to do it. Thanks.

[TheVader]

It happens because the loop is entered before the BeforeNavigate2 event has been reached. Try putting 'blnBusy = True' just before the loop; that should solve it.

[dglienna]

That does it. Thanks.
Can you interface with ASP with the same method?

[dglienna]

Fix the the code.

You did? Great. I did, too!

[bob5731]

Option Explicit
Dim UPC As String
Dim Document
Dim getElementsByTagName
Dim Item
Dim innerText
Dim a
Dim b
Dim c
Dim d
Dim f
Dim z
Dim blnBusy As Boolean

Private Sub Command1_Click()
Dim i As Integer

'Navigate to the page
WebBrowser1.Navigate2 "http://www.upcdatabase.com/nocheckdigit.pl"

'Both the readystate and the busy properties of the WB control
'are not completely reliable. The best way to wait for loading to take
'place I have found so far is using a custom boolean variable that
'is set in the BeforeNavigate2 and NavigateComplete2 events.
blnBusy = True
Do While blnBusy = True
DoEvents
Loop

'Fill in the upc number in the textbox with ID 'UPC'
'blnBusy = True
UPC = InputBox("Enter UPC Number", , "07800008846")
WebBrowser1.Document.getElementById("upc").Value = UPC

'Submit the first (and only) form in the page
WebBrowser1.Document.Forms.Item(0).submit

'Wait for the new page to load again
'blnBusy = True
Do While blnBusy = True
DoEvents
Loop

'Enumerate all TD tags in the document, because the info we want to extract
'is inside them.
For i = 0 To WebBrowser1.Document.getElementsByTagName("td").length - 1
Select Case WebBrowser1.Document.getElementsByTagName("td").Item(i).innerText
'If the text of the TD tag is one of the value names we're
'looking for, return the text in the second TD tag after it.
'As you can see in the source, all TD's with value names are
'followed by an empty TD tag and a TD tag containing the actual
'value. E.g. <td>Description</td><td></td><td>DR PEPPER CHER VAN 2LT</td>
Case "Description", "Size/Weight", "Manufacturer", "Entered/Modified"
MsgBox WebBrowser1.Document.getElementsByTagName("td").Item(i + 2).innerText
a = WebBrowser1.Document.getElementsByTagName("td").Item(i + 2).innerText
z = WebBrowser1
b = Document
c = getElementsByTagName
d = Item
f = innerText
Open "c:\pos\bob.dat" For Append As #1
Print #1, a,
Print #1, z, b, c, d, f
'Print #1, z,
'Print #1, b
'Print #1, c
'Print #1, d
'Print #1, f
'Print #1,
Close #1
End Select
Next i
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
blnBusy = True
End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
blnBusy = False
End Sub

Can you all fix for me?
It print one line and does not enter to print the next upc on the next line.

[dglienna]

Option Explicit
Dim UPC As String
Dim blnBusy As Boolean
dim field as string
dim ff as integer
dim lfield as integer
open app.path & "bob.dat" for APPEND as #ff
'
'  use the old code up to here
'
For i = 0 To WebBrowser1.Document.getElementsByTagName("td").length - 1
    Select Case WebBrowser1.Document.getElementsByTagName("td").Item(i).innerText
        lfield=0
        Case "Description"
           ifield = WebBrowser1.Document.getElementsByTagName("td").Item(i + 2).innerText
          lfield = 1
        case "Size/Weight"
           ifield = WebBrowser1.Document.getElementsByTagName("td").Item(i + 2).innerText
          lfield = 1
        case "Manufacturer"
           ifield = WebBrowser1.Document.getElementsByTagName("td").Item(i + 2).innerText
          lfield = 1
        case "Entered/Modified"
           ifield = WebBrowser1.Document.getElementsByTagName("td").Item(i + 2).innerText
          lfield= 2
    End Select
    if lfield = 1
        print #ff, chr$(34) & ifield & chr$(34) & ", " ;
      elseif
        if lfield=2
          print #ff, chr$(34) & ifield & chr$(34) 
      endif
Next i
close #ff
End Sub

this should be the way that you want to do it.

[bob5731]

can you all fix the code for me.

[bob5731]

can you all help me get fix.

[moeur]

Come on Bob, you can do it!
I too was unaware of the capabilities of the Document object always parsed text myself.
Thanks for the great examples Vader.
This is a great thread.

[luca90]

I think this is the first step. It loads the page into the forms web browser. Then upon the command1 click
it will enter the upc into the web page's textbox and sends an enter keypress. Then the page returns
with the upc data.

Option Explicit
'Add component to Microsoft HTML Object Library
'Add component Microsoft Internet Controls
 
'Add a command button (Command1)
'Add a web browser control to the form (WebBrowser1)
Dim hDoc As MSHTML.HTMLDocument
Dim hInp As MSHTML.HTMLInputElement
 
Private Sub Command1_Click()
    Set hInp = hDoc.getElementById("upc")
    hInp.focus
    hInp.Value = "07800008846"
    SendKeys "{ENTER}", True
End Sub
 
Private Sub Form_Load()
    WebBrowser1.Navigate2 "http://www.upcdatabase.com/nocheckdigit.pl"
End Sub
 
Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized Then
        WebBrowser1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 450 'Make adjustment for command button
    End If
End Sub
 
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    Set hDoc = WebBrowser1.Document
End Sub

Hi rob, i am very interesting on this question and naturally on you work...
I use Excel and VBA...
For you is possible to arrange this your code to put value from a column of sheet and put into a box present on this site and after press the button SUBMIT:

http://www.canadapost.ca/tools/pcl/bin/advanced-e.asp
Tks in advance.
Sal.

[Frans C]

Instead of entering the code in the textbox, you could load the result page immediately by using parameters in the URL
http://www.upcdatabase.com/item.pl?upc=078000088465

[RobDog888]

Instead of entering the code in the textbox, you could load the result page immediately by using parameters in the URL
http://www.upcdatabase.com/item.pl?upc=078000088465

But Frans, where would be the learning experience in doing that.
We want to write allot of code and use different techniques. Jk

[wildsidecreations]

ok. I seem to have figured out the clicking part. I am now having a problem with submitting the info into the next textbox. I belive it's a problem with frames. I think the vb code is tring to paste the text in the first frame. this is not the correct frame.

Option Explicit
 
Dim blnBusy As Boolean
 
Private Sub Command1_Click()
Dim i As Integer
 
 
'set this so the loop doesnt enter to quickly
blnBusy = True
 
'load went here
'Navigate to the page
WebBrowser1.Navigate2 "http://www.onestopmotors.com/admin"
 
'Both the readystate and the busy properties of the WB control
'are not completely reliable. The best way to wait for loading to take
'place I have found so far is using a custom boolean variable that
'is set in the BeforeNavigate2 and NavigateComplete2 events.
Do While blnBusy = True
    DoEvents
Loop
 
'Fill in the textboxs with user and pwd
WebBrowser1.Document.getElementById("txtUser").Value = "jason"
WebBrowser1.Document.getElementById("txtPwd").Value = "wopper"
WebBrowser1.Document.All.btnLogin.Click
 
'Submit went here
 
'Wait for the new page to load again
Do While blnBusy = True
    DoEvents
Loop
 
'Enumerate all TD tags in the document, because the info we want to extract
'is inside them.
For i = 0 To WebBrowser1.Document.getElementsByTagName("td").length - 1
    Select Case WebBrowser1.Document.getElementsByTagName("td").Item(i).innerText
        'If the text of the TD tag is one of the value names we're
        'looking for, return the text in the second TD tag after it.
        'As you can see in the source, all TD's with value names are
        'followed by an empty TD tag and a TD tag containing the actual
        'value. E.g. <td>Description</td><td></td><td>DR PEPPER CHER VAN 2LT</td>
        Case "Description", "Size/Weight", "Manufacturer", "Entered/Modified"
            MsgBox WebBrowser1.Document.getElementsByTagName("td").Item(i + 2).innerText
    End Select
Next i
End Sub
 
Private Sub Command2_Click()
 
'Navigate to the page
WebBrowser1.Navigate2 "http://www.onestopmotors.com/admin"
 
 
End Sub
 
 
Private Sub Command3_Click()
WebBrowser1.Document.getElementById("txtsearch").Value = Text1.Text
WebBrowser1.Document.All.btnSearch.Click
End Sub
 
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
blnBusy = True
End Sub
 
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
blnBusy = False
End Sub

[bob5731]

can all test and fix it if it need to be fixed. I do not have vb 6.0 and I am use windows vist.

[leinad31]

Instead of entering the code in the textbox, you could load the result page immediately by using parameters in the URL
http://www.upcdatabase.com/item.pl?upc=078000088465

Yup possible that way, as long as you keep in mind that some sites don't support GET method, or may suddenly shift to POST for security reasons.

[bob5731]

can you fix it?

[leinad31]

I can't access the page you guys are manipulating... do I need to register and is it free?

[bob5731]

no do not need to register
http://www.upcdatabase.com
I can go to it.

[leinad31]

How did you all get to page posted in post #26? I get an error page; resource not found for http://www.upcdatabase.com/nocheckdigit.pl

[bob5731]

the page have update then.

[bob5731]

can you help get get to work vb 08?
What is the new url http://www.upcdatabase.com/nocheckdigit.pl ?

[Hack]

I get RESOURCE NOT FOUND when I click your link Bob.

[bob5731]

RobDog888 give the link.

[bob5731]

I need to get the upc into Text1.
how do I do it.

Private Sub Command1_Click()
Dim ADOCn As ADODB.Connection
Dim ConnString As String
Dim sSQL As String
Dim iStart As Integer
Dim Text
    Dim iEnd As Integer
    iStart = 0
    iEnd = 0

ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source= C:\Users\bob\Desktop\UPC\games.mdb;" & _
        "Persist Security Info=False"

Set ADOCn = New ADODB.Connection
ADOCn.ConnectionString = ConnString
ADOCn.Open ConnString
Do While WebBrowser1.Busy = True
        DoEvents
        Sleep 500
    Loop
    Set hDoc = WebBrowser1.Document
    Set hInp = hDoc.getElementById("upc")
    'hInp.focus
    'hInp.Value = "02881920"
    'SendKeys "{ENTER}", True
    'Find the UPC
    iStart = InStr(1, hDoc.body.innerHTML, "<TD>upc</TD>") + 37
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    'MsgBox upc
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    Text1.Text = Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    Do While WebBrowser1.Busy = True
        DoEvents
        Sleep 500
    Loop
Set hInp = Nothing
    'Parse the elements and read the values of the data returned
    'Set document variable = to the new results documents page
    Set hDoc = WebBrowser1.Document
    'Find the description:
    iStart = InStr(1, hDoc.body.innerHTML, "<TD>Description</TD>") + 37
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    Text2.Text = Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find the Size/Weight:
    iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Size/Weight</TD>") + 37
    iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    Text3.Text = Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find Manufacturer:
    'iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Manufacturer</TD>") + 38
    'iEnd = InStr(iStart, hDoc.body.innerHTML, "(<A href=")
    'MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Text4.Text = Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Find the Entered/Modified:
    'iStart = InStr(iStart, hDoc.body.innerHTML, "<TD>Entered/Modified</TD>") + 42
    'iEnd = InStr(iStart, hDoc.body.innerHTML, "</TD></TR>")
    'MsgBox Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
    'Text5.Text = Mid$(hDoc.body.innerHTML, iStart, iEnd - iStart)
sSQL = "INSERT INTO table " & "(UPC, Description) VALUES ('" & Text1.Text & "', '" & Text2.Text & "')"
Debug.Print sSQL
'ADOCn.Execute sSQL
End Sub

Private Sub Form_Load()
    WebBrowser1.Navigate2 "http://www.upcdatabase.com/item.pl"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
'Dim strConn As String
'Dim strSQL As String
'strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\Brandon Crocker\Desktop\SALES 1\SALES 1\Database.mdb;Persist Security Info=False"
'strSQL = "SELECT * FROM MemberDetails"
End Sub