scrape data from website table

I would like to enter the value into a field on a website and save the data thats returned. The attached shows the returned value but I dont know how to create the code that responds to the included site table. Ive identified where it fails in the embedded code.

I am coding in VBA


Sub Main()
    Dim rsVINS As Recordset
    Dim rsMC As Recordset   'ModelColour
    Dim oXMLHTTP As Object
    Dim strHTML As String
    Dim oRE As Object
    Dim oMatches As Object
    Dim oM As Object
    Dim counter As Long
    Dim varReturn As Variant
 
    varReturn = SysCmd(acSysCmdSetStatus, "Text to write on the Status Bar!")
    
    
    
    url = "https://http://www.bmw-z1<wbr ></wbr>.com/VIN/V<wbr ></wbr>INdecode-e<wbr ></wbr>.cgi"

    Set oRE = CreateObject("vbscript.reg<wbr ></wbr>exp")
    oRE.Global = True
    oRE.Pattern = "<tr>\s*<td>(\w[^<]*)</td><wbr ></wbr>\s*<td>(\w<wbr ></wbr>[^<]*)</td<wbr ></wbr>>(?:.|\n)*<wbr ></wbr>?</tr>"

    Set rsVINS = DBEngine(0)(0).OpenRecords<wbr ></wbr>et("TblExp<wbr ></wbr>ortCodes",<wbr ></wbr> dbOpenTable)
    Set rsMC = DBEngine(0)(0).OpenRecords<wbr ></wbr>et("TblMod<wbr ></wbr>elLookup",<wbr ></wbr> dbOpenTable)
   
'    Do Until rsVINS.EOF Or counter = 5000
    Do Until rsVINS.EOF
        varReturn = SysCmd(acSysCmdSetStatus, counter)
        
        If rsVINS.Fields("lookedup").<wbr ></wbr>Value = True Then
        
        
        Else
    

'************** FAILS HERE **************************<wbr ></wbr>**********<wbr ></wbr>******
        Set oXMLHTTP = CreateObject("MSXML2.XMLHT<wbr ></wbr>TP")
      oXMLHTTP.Open "GET", "https://www.bmw-z1.com/VIN/VINdecode-e.cgi?lang=english&vin=" & rsVINS!StemRight, False

**************************<wbr ></wbr>**********<wbr ></wbr>**********<wbr ></wbr>**********<wbr ></wbr>********

        oXMLHTTP.send
       
        Do Until oXMLHTTP.ReadyState = 4
            DoEvents
        Loop
        
        If oXMLHTTP.Status = 200 Then
            strHTML = oXMLHTTP.responseText
            'parse the result
            If oRE.test(strHTML) Then
                Set oMatches = oRE.Execute(strHTML)
                For Each oM In oMatches
                    'push the data into the model table
                    rsMC.AddNew
                        rsMC!VehicleID = rsVINS!VRR_VehicleID
                        rsMC!VIN = rsVINS!Vintouse
                        rsMC!Chassis = oM.submatches(0)
                        rsMC!VehCode = oM.submatches(1)
                        rsMC!series = oM.submatches(2)
                        rsMC!Model = oM.submatches(3)
                        rsMC!Bodytype = oM.submatches(4)
                        rsMC!Catalogmodel = oM.submatches(5)
                        rsMC!ProdDate = oM.submatches(6)
                        rsMC!Engine = oM.submatches(7)
                        rsMC!Transmission = oM.submatches(8)
                        rsMC!Steering = oM.submatches(9)
                        rsMC!Catalyzer = oM.submatches(10)
                        
                        
                        
                        
                        
                    rsMC.Update
                Next
            End If
        End If
        
        rsVINS.Edit
        
        rsVINS.Fields("LookedUp") = True
        rsVINS.Update
        
        End If
        Forms!Main!txtStatus.Value<wbr ></wbr> = rsVINS!Vintouse + vbCrLf & Forms!Main!txtStatus.Value<wbr ></wbr>
        counter = counter + 1
        Forms!Main.Refresh
        
        rsVINS.MoveNext
        varReturn = SysCmd(acSysCmdSetStatus, " ")
    Loop
    
MsgBox ("finished: " & Now())

    
End Sub

Open in new window

bmwcapture.JPG
PeterBaileyUkAsked:
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.

Chris Raisin(Retired Analyst/Programmer)Commented:
Which references have you added to your project?

Are you compiling this through VB6 or is it via a Microsoft product such as Access?

Cheers
Chris (Australia)
0
PeterBaileyUkAuthor Commented:
This code was being used on a different site previously I have just updated the web url to the new site i want to scrape from
http://www.bmw-z1.com/VIN/VINdecode-e.cgi

i just spotted in the code extract that the url was pasted incorrectly but that was corrected:

url = "https://www.bmw-z1.com/VIN/VINdecode-e.cgi"

its just a question of identifying the variables in the web page and putting them in here:

oXMLHTTP.Open "GET", "https://www.bmw-z1.com/VIN/VINdecode-e.cgi?cmd=_s-xclick & vin=" & rsVINS!StemRight, False

I believe
0
Chris Raisin(Retired Analyst/Programmer)Commented:
OH, I understand.

Normally the way to identify the variables ion a page is to look underlying  code of the web page by right mouse-button
clicking and selecting "View HTML", however we have a problem here because the page you are looking at is a CGI script
(probably written in Perl/C) and cannot be seen via that method.
(Be awatre that CGI scripts are very prone to securityleaks, by the way).

Anyway., stand by while I inbestogate if there is a way  to get the names of the varioables for you.

Cheers
Chris
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

PeterBaileyUkAuthor Commented:
ok if not i have an alternate website
0
PeterBaileyUkAuthor Commented:
I found a decode site here too:
http://www.realoem.com/bmw/select.do
0
Chris Raisin(Retired Analyst/Programmer)Commented:
OK, let us know the alternative website URL, if you like, but I have found the code in the CGI by using the great WebBrowser "Maxthon Cloud" (www.maxthon.com) which incorporates a programmer utility to view the internal structure of web pages.

I reproduce the code below (using screen captures unfortunately because you cannot copy/past the code from the page)

The input field apparently has the name "VIN".

Refer to the line:
     <form action="VINdecode-e.cgi"  method=POST   name="VIN"  id="1444692392">

Screen capture of underlying HTML code produced by C code on CGI script page
0
Chris Raisin(Retired Analyst/Programmer)Commented:
That second link is a bit more compluicated ssince it is written using Javascript, but it's underlying HTMNL also has an input field with the name "vin" (all lower case).

Note the case is important if you are using code to search the internal HTML of these pages.

If you like, I can also attach the code for the second page.

I have produced a 6 minute video which shows how to use the developer tool that comes with maxthon.
It is available via this link:
https://filedb.experts-exchange.com/incoming/ee-stuff/8410-Checking-underlying-CGI-or-HTML.mp4




I hope this answers your question. :-)

Cheers
Chris (Australia)
0
PeterBaileyUkAuthor Commented:
Yes I have installed maxthon now and identified the names but how does that html statement change now to enter my vin and submit

oXMLHTTP.Open "GET", "https://www.bmw-z1.com/VIN/VINdecode-e.cgi?**not sure what to add here to submit rsVINS!StemRight ******" & rsVINS!StemRight, False
ee2.JPG
0
Chris Raisin(Retired Analyst/Programmer)Commented:
You will need to put in place code similar to the following (I have not tested it, since I am not aware of the full coding you are using). It would be best not to create the browser each time you submit the VIN for submission
(execessive processing), but if you are familiar with VBA you should be able to work out how to create the IE Browser outside the subroutine (as"Private" to the entire module")

If you do not understand what I mean by that, I can elaborate later. This code is just to give you and idea of how to process the submission.

Muck around with it and see if it helps you out.

Cheers
Chris

in yourmain code make a call to "submitVIN
.......
.......
submitVIN( RSVINS!StemRight )
.......
.......

The code for this routine is as follows:

Private Sub SubmitVIN  (strVIN as string)
    Dim i As Long
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
 
    ' Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")
 
    ' You can comment out the next line to ensure the browser is visible if that is what you wish
    IE.Visible = False
 
    ' Send the form data To URL As POST binary request
    IE.Navigate "http://www.bmw-z1.com/VIN/VINdecode-e.cgi"
 
    ' Statusbar
    Application.StatusBar = "http://www.bmw-z1.com/VIN/VINdecode-e.cgi is loading. Please wait..."
 
    ' Wait while IE loading...
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)     'Wait one second
        DoEvents                                                    'This is important, we do not want to Hog the processor!
    Loop
 
    ' Find 2 input tags:
    '   1. Text field
    '   <input type="text" name="VIN" />
    '
    '   2. Button
    '   <input type="submit" class="button" value="" />
    
    Application.StatusBar = "Search form submission. Please wait..."
 
    Set objCollection = IE.document.getElementsByTagName("Input")
 
    i = 0
    While i < objCollection.Length
        If objCollection(i).Name = "vin" Then
 
            ' Set text for search
            objCollection(i).Value = strVIN      'passedto this routine by main procedure
 
        Else
            If objCollection(i).Type = "submit" And _
               objCollection(i).Name = "DECODE" Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If
        End If
        i = i + 1
    Wend
    objElement.Click    ' click button to search
    
    ' Wait while IE re-loading...
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)  'Wait a second to allow refreshing
        DoEvent                                                   'Agaiun...no hogging!
    Loop
 
    ' Show IE
    'The followingline may not be required if the Browser is already showing (see above)
    IE.Visible = True
 
    ' Clean up
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
 
    Application.Statusbar = ""
End sub

Open in new window

0

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
PeterBaileyUkAuthor Commented:
i am getting method or data member not found on this line:
  Application.wait DateAdd("s", 1, Now)

maybe i am missing a reference to something?
0
PeterBaileyUkAuthor Commented:
ok i substituted application.wait for a slightly different wait.

now its not evaluating the click, it passes the value into the input box though correctly, it cannot get to set the objElement, hence it fails on objElement.click

 If objCollection(i).Type = "submit" And _
               objCollection(i).Name = "DECODE" Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If
        End If
        i = i + 1
    Wend
    objElement.Click    ' click button to search
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Can you put on the debugger and step your way through the code?
If so, place a breakpoint (F9) on the line "if objCollection(i).TYpe=........"
andthen press F5 to run.

When the debugger stops on the line, add a "Watch" for objElement(i) and look at its values when the debugger stops.
You may find that the Type is "Submit" pr "SUBMIT" OR THAT THE NAME IS NOT ALL UPPERCASE (although the internals indicate otherwise).

What are you using instead of "Application.wait" ?

Cheers
Chris
0
PeterBaileyUkAuthor Commented:
for the wait issue i used:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

where required   Sleep (2000)
0
PeterBaileyUkAuthor Commented:
at present the code is like this but i've been debugging but havn't found the source of the bug yet, I tried the uppercase value too

Option Compare Database
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public WaitTimeSecs, url, start_time, end_time, appPEU, logged_on, targetRs, sourceRs, cnt1
Private Sub SubmitVIN(strVIN As String)
    Dim i As Long
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
 
    ' Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")
 
    ' You can comment out the next line to ensure the browser is visible if that is what you wish
    IE.Visible = True
 
    ' Send the form data To URL As POST binary request
    IE.Navigate "http://www.bmw-z1.com/VIN/VINdecode-e.cgi"
 
    ' Statusbar
'    Application.Statusbar = "http://www.bmw-z1.com/VIN/VINdecode-e.cgi is loading. Please wait..."
 
    ' Wait while IE loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)     'Wait one second
        Sleep (2000)
'        DoEvents
        'This is important, we do not want to Hog the processor!
        
    Loop
 
    ' Find 2 input tags:
    '   1. Text field
    '   <input type="text" name="VIN" />
    '
    '   2. Button
    '   <input type="submit" class="button" value="" />
    
'    Application.Statusbar = "Search form submission. Please wait..."
 
    Set objCollection = IE.Document.getElementsByTagName("Input")
 
    i = 0
    While i < objCollection.Length
        If objCollection(i).Name = "vin" Then
 
            ' Set text for search
            objCollection(i).Value = strVIN      'passed to this routine by main procedure
 
        Else
            If objCollection(i).Type = "SUBMIT" And _
               objCollection(i).Name = "DECODE" Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If
        End If
        i = i + 1
    Wend
    objElement.Click    ' click button to search
    
    ' Wait while IE re-loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)  'Wait a second to allow refreshing
Sleep (2000)
'        DoEvent                                                   'Agaiun...no hogging!
    Loop
 
    ' Show IE
    'The followingline may not be required if the Browser is already showing (see above)
    IE.Visible = True
 
    ' Clean up
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
 
'    Application.Statusbar = ""
End Sub

Open in new window

0
PeterBaileyUkAuthor Commented:
ive attached a copy
Option Compare Database
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public WaitTimeSecs, url, start_time, end_time, appPEU, logged_on, targetRs, sourceRs, cnt1
Private Sub SubmitVIN(strVIN As String)
    Dim i As Long
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
 
    ' Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")
 
    ' You can comment out the next line to ensure the browser is visible if that is what you wish
    IE.Visible = True
 
    ' Send the form data To URL As POST binary request
    IE.Navigate "http://www.bmw-z1.com/VIN/VINdecode-e.cgi"
 
    ' Statusbar
'    Application.Statusbar = "http://www.bmw-z1.com/VIN/VINdecode-e.cgi is loading. Please wait..."
 
    ' Wait while IE loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)     'Wait one second
        Sleep (2000)
'        DoEvents
        'This is important, we do not want to Hog the processor!
        
    Loop
 
    ' Find 2 input tags:
    '   1. Text field
    '   <input type="text" name="VIN" />
    '
    '   2. Button
    '   <input type="submit" class="button" value="" />
    
'    Application.Statusbar = "Search form submission. Please wait..."
 
    Set objCollection = IE.Document.getElementsByTagName("Input")
 
    i = 0
    While i < objCollection.Length
        If objCollection(i).Name = "vin" Then
 
            ' Set text for search
            objCollection(i).Value = strVIN      'passed to this routine by main procedure
 
        Else
            If objCollection(i).Type = "SUBMIT" And _
               objCollection(i).Name = "DECODE" Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If
        End If
        i = i + 1
    Wend
    objElement.Click    ' click button to search
    
    ' Wait while IE re-loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)  'Wait a second to allow refreshing
Sleep (2000)
'        DoEvent                                                   'Agaiun...no hogging!
    Loop
 
    ' Show IE
    'The followingline may not be required if the Browser is already showing (see above)
    IE.Visible = True
 
    ' Clean up
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
 
'    Application.Statusbar = ""
End Sub

Open in new window

ee.mdb
0
PeterBaileyUkAuthor Commented:
I printed the values of index i versus name and type:

Index: 0
Name:  vin
type: text
Index: 1
Name:  
type: submit
Index: 2
Name:  lang
type: hidden
Index: 3
Name:  cmd
type: hidden
Index: 4
Name:  submit
type: image
Index: 5
Name:  encrypted
type: hidden
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Try amending:
            If objCollection(i).Type = "SUBMIT" And _
               objCollection(i).Name = "DECODE" Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If

Open in new window


to:
            If objCollection(i).Type = "image" And _
               objCollection(i).Name = "button" Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If

Open in new window

0
PeterBaileyUkAuthor Commented:
it still wont find that combination the only pairs it finds are here (it must be close):
length of object: 6
Index: 0
Name:  vin
type: text
Index: 1
Name:  
type: submit
Index: 2
Name:  lang
type: hidden
Index: 3
Name:  cmd
type: hidden
Index: 4
Name:  submit
type: image
Index: 5
Name:  encrypted
type: hidden
0
PeterBaileyUkAuthor Commented:
this :

  If objCollection(i).Type = "image" And _
               objCollection(i).Name = "submit" Then

clicks the paypal button

so it has to be Name =submit with a different type
0
PeterBaileyUkAuthor Commented:
I notice on index 1 the name is null
0
PeterBaileyUkAuthor Commented:
ok I did this:
   If objCollection(i).Type = "submit" And i = 1 Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If
0
PeterBaileyUkAuthor Commented:
I have to pull out the return ie try ZC48089 so i assume i can find the table fields somehow.
0
PeterBaileyUkAuthor Commented:
what i will do is close this question and award the points and p[ost a new question on data retrieval
0
PeterBaileyUkAuthor Commented:
Thank you so much for your detailed explanations
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Do not test that i=1, because if they ever change the webpage on you it will break your macro.

Always test on "type" and "name".

Looking at the setup on the internals on the page we have:

Form portion of Internals on CGI page
The input "type" looks like " submit " (it appears to have spaces at start and finish of the type declaration) and the "value" appears to be " DECODE " (again it may or may not have spaces before and after the word "DECODE".

Try the coding:

     If objCollection(i).Type = "submit" And objCollection(i).Value = "DECODE" Then

                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If

Open in new window

0
PeterBaileyUkAuthor Commented:
That last piece of code worked.

is there an easy way to grab the returned table data? i assume now the html is updated to include the td and tr
0
Chris Raisin(Retired Analyst/Programmer)Commented:
The values returned by entering ZC48089 value are:

Data returned for Item ZC48089
The internal code FOR THIS TABLE looks like this (using Maxthon):

Table data (internals in CGI code) for ZC48089
You were right, each item is presented in a table row with table data (td).

You can use the same methodology in your code to serch through and each time you find "<td>" and </td>" in a line, then you know the next line is details of the data being reported back (e.g. Production date") and the line followiing that is the required data ("e.g. 1999    / 04   ").

What you could do is store all the text from the page into a variable and search for your table values,
I have just done this code in my head and not tested it. If you have problems get back to me and I will
help out.

Cheers
Chris

Sub GetDataFromTable

    dim sDocText as string
    dim Lines() as string
    dim nLines as integer
    dim nLine as integer

    sDocText = document.innerhtml

    Lines = split(sDocText, vbcrLF)

    for nLine = 0 to ubound(Lines)-1
         if instr(Lines(nLine),"<table border") > 0 then
              Do while instr(Lines(nLine),"/table") = 0 
                   if instr(Lines(nLine),"<td>") > 0 and  and instr(Lines(nLine),"</td>") > 0 then
                        'we are at a description line
                         strDesc = replace(replace(Lines(nLine),"<td>",""),</td>","")
                         ' the next line will be the value
                         nLine = nLine + 1
                         strValue = replace(replace(Lines(nLine),"<td>",""),</td>","")            
                         'Now place some code here now to process the newly acquired 
                         'strDesc and strValue
                   endif
                   nLine = nLine + 1
               Loop
               Exit for
           endif         
      next
end sub

Open in new window

0
PeterBaileyUkAuthor Commented:
thank you will take a look after the eclipse tomorrow.
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Hmmmm. You must work for an observatory!     :-)     LOL
0
PeterBaileyUkAuthor Commented:
noooo i wish, i just worked like a dog this week to get a couple of hours off to photograph it.
0
PeterBaileyUkAuthor Commented:
its squeeling here where a string is relating to an object thats not defined.

sDocText = document.innerhtml

do you want me to open another question to deal with this?
0
Chris Raisin(Retired Analyst/Programmer)Commented:
No, stick with this one. As I said, I did the code in my head and the "innerhtml" was just a misty memory of other code I have written.
I will review the code wqhen I get backl from my bridge club (in about 8 hours).

Cheers
Chris
0
PeterBaileyUkAuthor Commented:
ok  thx.
0
Chris Raisin(Retired Analyst/Programmer)Commented:
I haven't forgotten you! I am working on it now and should have a solution shortly.

Cheers
Chris
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Could you please post the code you are now working with (after any changes made since this question was first posted).
(Including my included code which is complaining to you).

Many thanks
Chris
0
PeterBaileyUkAuthor Commented:
I didnt think you had forgotton I was just being patient, here is the main (this passes the vins) and the other two routines

Sub GetDataFromTable()
       Dim sDocText As String
    Dim Lines() As String
    Dim nLines As Integer
    Dim nLine As Integer

    sDocText = objCollection.InnerHtml
    Lines = Split(sDocText, vbCrLf)

    For nLine = 0 To UBound(Lines) - 1
         If InStr(Lines(nLine), "<table border") > 0 Then
              Do While InStr(Lines(nLine), "/table") = 0
                   If InStr(Lines(nLine), "<td>") > 0 And InStr(Lines(nLine), "</td>") > 0 Then
                        'we are at a description line
                         strDesc = Replace(Replace(Lines(nLine), "<td>", ""), "</td>", "")
                         ' the next line will be the value
                         nLine = nLine + 1
                         strValue = Replace(Replace(Lines(nLine), "<td>", ""), "</td>", "")
                         'Now place some code here now to process the newly acquired
                         'strDesc and strValue
                   End If
                   nLine = nLine + 1
               Loop
               Exit For
           End If
      Next
    

End Sub
Private Sub SubmitVIN(strVIN As String)
    Dim i As Long
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
 
    ' Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")
 
    ' You can comment out the next line to ensure the browser is visible if that is what you wish
    IE.Visible = True
 
    ' Send the form data To URL As POST binary request
    IE.Navigate "http://www.bmw-z1.com/VIN/VINdecode-e.cgi"
 
    ' Statusbar
'    Application.Statusbar = "http://www.bmw-z1.com/VIN/VINdecode-e.cgi is loading. Please wait..."
 
    ' Wait while IE loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)     'Wait one second
        Sleep (4000)
'        DoEvents
        'This is important, we do not want to Hog the processor!
        
    Loop
 
    ' Find 2 input tags:
    '   1. Text field
    '   <input type="text" name="VIN" />
    '
    '   2. Button
    '   <input type="submit" class="button" value="" />
    
'    Application.Statusbar = "Search form submission. Please wait..."
 
    Set objCollection = IE.Document.getElementsByTagName("input")
 
    i = 0
    Debug.Print "length of object: " & objCollection.Length
    While i < objCollection.Length
        If objCollection(i).Name = "vin" Then

            ' Set text for search
            objCollection(i).Value = strVIN      'passed to this routine by main procedure
            Debug.Print "Index: " & i
            Debug.Print "Name: " & " " & objCollection(i).Name
        
          Debug.Print "type: " & objCollection(i).Type
        Else
            Debug.Print "Index: " & i
         Debug.Print "Name: " & " " & objCollection(i).Name
         Debug.Print "type: " & objCollection(i).Type
         
            If objCollection(i).Type = "submit" And i = 1 Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If
        End If
        i = i + 1
    Wend
    Debug.Print
    objElement.Click    ' click button to search
    
    ' Wait while IE re-loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)  'Wait a second to allow refreshing
Sleep (2000)
'        DoEvent                                                   'Agaiun...no hogging!
    Loop
 
    ' Show IE
    'The followingline may not be required if the Browser is already showing (see above)
    IE.Visible = True
    
    '***** get tabledata
    
 
    
    
    
    
 
    ' Clean up
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
 
'    Application.Statusbar = ""
End Sub
Sub Main()
    Dim rsVINS As Recordset
    Dim rsMC As Recordset   'ModelColour
    Dim oXMLHTTP As Object
    Dim strHTML As String
    Dim oRE As Object
    Dim oMatches As Object
    Dim oM As Object
    Dim counter As Long
    Dim varReturn As Variant
 
    varReturn = SysCmd(acSysCmdSetStatus, "Text to write on the Status Bar!")
    
    
    
'    url = "https://www.bmw-z1.com/VIN/VINdecode-e.cgi"
'
'    Set oRE = CreateObject("vbscript.regexp")
'    oRE.Global = True
'    oRE.Pattern = "<tr>\s*<td>(\w[^<]*)</td>\s*<td>(\w[^<]*)</td>(?:.|\n)*?</tr>"

    Set rsVINS = DBEngine(0)(0).OpenRecordset("TblExportCodes", dbOpenTable)
    Set rsMC = DBEngine(0)(0).OpenRecordset("TblModelLookup", dbOpenTable)
   
'    Do Until rsVINS.EOF Or counter = 5000
    Do Until rsVINS.EOF
        varReturn = SysCmd(acSysCmdSetStatus, counter)
        
        Call SubmitVIN(rsVINS!StemRight)
'        Call GetDataFromTable
 
        Forms!Main!txtStatus.Value = rsVINS!StemRight + vbCrLf & Forms!Main!txtStatus.Value
        counter = counter + 1
        Forms!Main.Refresh
        
        rsVINS.MoveNext
        varReturn = SysCmd(acSysCmdSetStatus, " ")
    Loop
    
MsgBox ("finished: " & Now())

    
End Sub

Open in new window

0
PeterBaileyUkAuthor Commented:
the cutdown dbhere
Sub GetDataFromTable()
       Dim sDocText As String
    Dim Lines() As String
    Dim nLines As Integer
    Dim nLine As Integer

    sDocText = objCollection.InnerHtml
    Lines = Split(sDocText, vbCrLf)

    For nLine = 0 To UBound(Lines) - 1
         If InStr(Lines(nLine), "<table border") > 0 Then
              Do While InStr(Lines(nLine), "/table") = 0
                   If InStr(Lines(nLine), "<td>") > 0 And InStr(Lines(nLine), "</td>") > 0 Then
                        'we are at a description line
                         strDesc = Replace(Replace(Lines(nLine), "<td>", ""), "</td>", "")
                         ' the next line will be the value
                         nLine = nLine + 1
                         strValue = Replace(Replace(Lines(nLine), "<td>", ""), "</td>", "")
                         'Now place some code here now to process the newly acquired
                         'strDesc and strValue
                   End If
                   nLine = nLine + 1
               Loop
               Exit For
           End If
      Next
    

End Sub
Private Sub SubmitVIN(strVIN As String)
    Dim i As Long
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
 
    ' Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")
 
    ' You can comment out the next line to ensure the browser is visible if that is what you wish
    IE.Visible = True
 
    ' Send the form data To URL As POST binary request
    IE.Navigate "http://www.bmw-z1.com/VIN/VINdecode-e.cgi"
 
    ' Statusbar
'    Application.Statusbar = "http://www.bmw-z1.com/VIN/VINdecode-e.cgi is loading. Please wait..."
 
    ' Wait while IE loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)     'Wait one second
        Sleep (4000)
'        DoEvents
        'This is important, we do not want to Hog the processor!
        
    Loop
 
    ' Find 2 input tags:
    '   1. Text field
    '   <input type="text" name="VIN" />
    '
    '   2. Button
    '   <input type="submit" class="button" value="" />
    
'    Application.Statusbar = "Search form submission. Please wait..."
 
    Set objCollection = IE.Document.getElementsByTagName("input")
 
    i = 0
    Debug.Print "length of object: " & objCollection.Length
    While i < objCollection.Length
        If objCollection(i).Name = "vin" Then

            ' Set text for search
            objCollection(i).Value = strVIN      'passed to this routine by main procedure
            Debug.Print "Index: " & i
            Debug.Print "Name: " & " " & objCollection(i).Name
        
          Debug.Print "type: " & objCollection(i).Type
        Else
            Debug.Print "Index: " & i
         Debug.Print "Name: " & " " & objCollection(i).Name
         Debug.Print "type: " & objCollection(i).Type
         
            If objCollection(i).Type = "submit" And i = 1 Then
 
                ' "Search" button is found
                Set objElement = objCollection(i)
 
            End If
        End If
        i = i + 1
    Wend
    Debug.Print
    objElement.Click    ' click button to search
    
    ' Wait while IE re-loading...
    Do While IE.Busy
'        Application.wait DateAdd("s", 1, Now)  'Wait a second to allow refreshing
Sleep (2000)
'        DoEvent                                                   'Agaiun...no hogging!
    Loop
 
    ' Show IE
    'The followingline may not be required if the Browser is already showing (see above)
    IE.Visible = True
    
    '***** get tabledata
    
 
    
    
    
    
 
    ' Clean up
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
 
'    Application.Statusbar = ""
End Sub
Sub Main()
    Dim rsVINS As Recordset
    Dim rsMC As Recordset   'ModelColour
    Dim oXMLHTTP As Object
    Dim strHTML As String
    Dim oRE As Object
    Dim oMatches As Object
    Dim oM As Object
    Dim counter As Long
    Dim varReturn As Variant
 
    varReturn = SysCmd(acSysCmdSetStatus, "Text to write on the Status Bar!")
    
    
    
'    url = "https://www.bmw-z1.com/VIN/VINdecode-e.cgi"
'
'    Set oRE = CreateObject("vbscript.regexp")
'    oRE.Global = True
'    oRE.Pattern = "<tr>\s*<td>(\w[^<]*)</td>\s*<td>(\w[^<]*)</td>(?:.|\n)*?</tr>"

    Set rsVINS = DBEngine(0)(0).OpenRecordset("TblExportCodes", dbOpenTable)
    Set rsMC = DBEngine(0)(0).OpenRecordset("TblModelLookup", dbOpenTable)
   
'    Do Until rsVINS.EOF Or counter = 5000
    Do Until rsVINS.EOF
        varReturn = SysCmd(acSysCmdSetStatus, counter)
        
        Call SubmitVIN(rsVINS!StemRight)
'        Call GetDataFromTable
 
        Forms!Main!txtStatus.Value = rsVINS!StemRight + vbCrLf & Forms!Main!txtStatus.Value
        counter = counter + 1
        Forms!Main.Refresh
        
        rsVINS.MoveNext
        varReturn = SysCmd(acSysCmdSetStatus, " ")
    Loop
    
MsgBox ("finished: " & Now())

    
End Sub

Open in new window

ee2.mdb
0
PeterBaileyUkAuthor Commented:
i assume that the object objcollection automatically updates once the page returns the data, i do have a regex pattern to find the td data.
0
Chris Raisin(Retired Analyst/Programmer)Commented:
One final thing.

Could you please send me the from you have in your project? (or a screencapture showing the names of the various objects on it, e.g. textboxes etc.)

I am trying to get the code to work at my end.

Cheers
Chris
0
PeterBaileyUkAuthor Commented:
the form only has one button on it that calls the main routine
Capture.JPG
Capture2.JPG
0
PeterBaileyUkAuthor Commented:
the main just works through a table and grabs the vin until it reaches the end of the table
0
PeterBaileyUkAuthor Commented:
if i go silent in an hour is because i have doctors appointment.
0
Chris Raisin(Retired Analyst/Programmer)Commented:
We are on the same wavelength now.

I found everything inside you database object.

Stand by.......

Chris
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Your code refers to "Forms!Main!" but I can only see a "Forms!Form1" in the design.

Am I missing a form?
0
PeterBaileyUkAuthor Commented:
no the code was lifted from a previous db that did a similar task previously
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Is you code stopping at the line:

Forms!Main!txtStatus.Value = rsVINS!StemRight + vbCrLf & Forms!Main!txtStatus.Value

If so, we are missing filed on a Form named "Main".

I think I will just change the code to read:
Forms!Form1!txtStatus.Value = rsVINS!StemRight + vbCrLf & Forms!Form1!txtStatus.Value
and create a textfield in it (with multiple lines) named txtStatus.

Stand by......
0
PeterBaileyUkAuthor Commented:
it fails:
Sub GetDataFromTable() .... in this sub
       Dim sDocText As String
    Dim Lines() As String
    Dim nLines As Integer
    Dim nLine As Integer

    sDocText = objCollection.innerHTML....fails here object required

any reference to the other form can be remmed out as it was only a method of showing where the process had got.
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Gotcha! I have abandoned writing anything to the text box.

I have the code working (of sorts).I just have to see where in the cgi code the data which is displaying on the webpage is stored.

Stand By.....
0
PeterBaileyUkAuthor Commented:
it returns i think as table data which this should be able to pull out:

  Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    oRE.Pattern = "<tr>\s*<td>(\w[^<]*)</td>\s*<td>(\w[^<]*)</td>(?:.|\n)*?</tr>"
0
PeterBaileyUkAuthor Commented:
when i did a view source it was buried in the html
0
Chris Raisin(Retired Analyst/Programmer)Commented:
OK - Is all working now.  (See attached file which I renamed to ee3.mdb so it will not overwrite what you have written ).

Please note my comments about "DoEvents"

Also, It is only processing one item (I gather there is only one in the database)

I ran it numerous times so it will have added the same record in multiple times you will find (If you are not, then there should be some sort of "commit" or "save" after each record is processed (I am too tired to try that out at the moment).

At least it shows you now how to extract the data from the page.

I am toddling off to bed now, since it is 5am and I have spent 6 hours on this. (I am teaching at 9.30am)

Cheers
Chris
ee3.mdb
0
PeterBaileyUkAuthor Commented:
tha'ts kind of you, you didnt need to do that I was hoping for a prompt to get the html text and it seems your in a very different timezone to me too.

varReturn = SysCmd(acSysCmdSetStatus, " ") 'also, what the heck is this line about?

this is a way that when I process thousands of vehicles it prints a counter to the status bar in the access border itself. that way if it gets close to the 2gb limit I can get back to where I was because I have the counter.
0
Chris Raisin(Retired Analyst/Programmer)Commented:
Great!

Did the code work at your end?

Cheers
Chris (Yes - am just awake again)  LOL :-)
0
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
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.