• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 194
  • Last Modified:

save data from html return

An expert assisted ID: 40675334 and I can now send the data to the webpage and get a return, how do I grab the html from the return and save that data in access vba?
0
PeterBaileyUk
Asked:
PeterBaileyUk
  • 8
  • 4
  • 3
1 Solution
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
You'll have to give more detail - what, exactly, are you receiving from the "return", and how is it formatted?
0
 
PeterBaileyUkAuthor Commented:
here is the code I have so far..
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
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 submit works fine, i just need to retrieve the data.
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
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
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:
this has been solved as part of the previous id I mentioned so I will invite that expert to post the solution so no further guidance needed.
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
this has been solved as part of the previous id I mentioned so I will invite that expert to post the solution so no further guidance needed.
Thanks for wasting my time ...
0
 
PeterBaileyUkAuthor Commented:
The expert had replied in the meantime..I took advisement from support..they looked at this and suggested that course of action so sorry you feel that way particularly as the question had been dormant since 12.49. when the solution gets moved over i have no doubt that the points could be shared.
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
The solution is found fully in the attached file which I have named ee3.mdb,

The question here was a little misleading because there is actually no pure html on the CGI web pages used in the question. That was probably my fault since I mentioned in the earlier question that we would have to look at the Innerhtml property of the text on the CGI page.

I then discovered that CGI is produced by "C/JavaScript" which writes the HTML tags out, but they are not set out like ordinary HTML and the webpages produced do not have "InnerHTML".

I had to search for certain elements in the CGI page (The "<TR> or row elements of the table) and then look at "Innertext" of the elements to find the data.

I spent about 6 hours solving this exercise after Question 40684614 was closed, and I posted the result there as further work on the question (oblivious to points). I was not aware that Peter had posted a new question. I am so sorry to cause this hiccup.

I am sorry too that Scott felt a bit hard done by, and his final comment could perhaps have been a little more considered (but maybe he was tired, like me). Still,we are all here to help our fellow humans .

Sorry Scott, I hope you did not put too much time and effort into finding a solution.

I hope the code in the attached MDB allows Peter to process his data, and please, everyone, rest assured that I am always around to help  whenever I can.

Kindest regards to all,

Chris (Melbourne, Australia)
ee3.mdb
0
 
PeterBaileyUkAuthor Commented:
I gave some points to Scot too hope you find that acceptable. Thank you to all.
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
No problems :-)

Cheers
C hris
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
I've asked the Moderators to remove my points, as the comment you selected is not a technical comment.

My point is this - you should not ask the same question in two different places, since doing so wastes the time of the VOLUNTEER Experts who are trying to help in each question. It's also a violation of EE policy. If you're not getting help in the first question, then use the RA button to ask the Mods to attract more attention - don't post a second question that is more-or-less identical to the first.
0
 
PeterBaileyUkAuthor Commented:
actually that was not the case and as I had sought advisement from the chat service as what to do I get the feeling that you sir are just being awkward to say the least.

The previous id was a completely unrelated point that had been answered, so your point is factually incorrect, the new question was a different point about extraction of the data and how it would be saved the first question was about scraping the data from the website.

so the fact that the other expect had answered it after the first question was closed and five hours after you gave a first reply with no solution makes no material effect.

I have not breached any conditions here as I have a chat session that proves I sought advice from the help service in this matter.

Quite frankly your attitude is appalling and not in any spirit at all.
0
 
PeterBaileyUkAuthor Commented:
for clarity here is the coded solution to this question provided by Chris which was in the attached DB at ID: 40686007. The chat session text I shall keep for the moderator should he require it as it is proof no break of rules occurred despite the objection.

The points were partly shared not for the solution as the first poster in this thread never gave one but it was given in the spirit of co-operation leading up to a solution.

Option Compare Database
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim objCollection As Object  'make this available to entire module
Dim IE As Object 'make this also available to the entire module
Public WaitTimeSecs, url, start_time, end_time, appPEU, logged_on, targetRs, sourceRs, cnt1
Sub GetDataFromTable(rsmc As Recordset, rsVINS As Recordset)
    Dim sData As String
    Dim Lines() As String
    Dim nLines As Integer
    Dim nLine As Integer
    Dim els As New Collection
    Dim el As Object
    For Each el In IE.Document.getelementsbytagname("tr") 'look at each element that forms part of a tablerow
       nLine = nLine
       If Len(Trim(el.innertext)) > 0 Then
         sData = sData & el.innertext & vbCrLf
       End If
    Next el
    Lines = Split(sData, vbCrLf)
    rsmc.AddNew   'adda new record to the recordset
    rsmc!VehicleID = rsVINS!VRR_VehicleID
    rsmc!vin = rsVINS!Vintouse
    For nLine = 0 To UBound(Lines) - 1
        'This is where you write your values out to your database
        'Note the CASE (Upper/Lower) is very important in this block of code
        If InStr(Lines(nLine), "Chassis number") > 0 Then
           rsmc!chassis = Trim(Replace(Lines(nLine), "Chassis number", ""))
        ElseIf InStr(Lines(nLine), "Vehicle code") > 0 Then
           rsmc!VehCode = Trim(Replace(Lines(nLine), "Vehicle code", ""))
        ElseIf InStr(Lines(nLine), "Series") > 0 Then
           rsmc!series = Trim(Replace(Lines(nLine), "Series", ""))
        ElseIf InStr(Lines(nLine), "Model") > 0 Then
            rsmc!Model = Trim(Replace(Lines(nLine), "Model", ""))
        ElseIf InStr(Lines(nLine), "Body type") > 0 Then
            rsmc!Bodytype = Trim(Replace(Lines(nLine), "Body type", ""))
        ElseIf InStr(Lines(nLine), "Production date") > 0 Then
            rsmc!ProdDate = Trim(Replace(Lines(nLine), "Production date", ""))
        ElseIf InStr(Lines(nLine), "EngineR") > 0 Then
            rsmc!Engine = Trim(Replace(Lines(nLine), "EngineR", ""))
        ElseIf InStr(Lines(nLine), "Transmission") > 0 Then
            rsmc!Transmission = Trim(Replace(Lines(nLine), "Transmission", ""))
        ElseIf InStr(Lines(nLine), "Steering") > 0 Then
            rsmc!Steering = Trim(Replace(Lines(nLine), "Chassis Number", ""))
        ElseIf InStr(Lines(nLine), "Catalyzer") > 0 Then
            rsmc!Catalyzer = Trim(Replace(Lines(nLine), "Catalyzer", ""))
        End If
    Next
    rsmc.Update
End Sub

Open in new window

0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
Peter,

The declarations above the subroutine name should not appear here, since they are not needed in this module and will only puzzle others looking at the code. This is a standalone subroutine.

Also, I assume you saw that the "sleep" command should not be used (it will only slow you down).
The "DoEvents" command will release processing time to your machine when needed for background processing.
If you do not put "DoEvents": in it will make you program run very slowly externally to the Access procedure. and slow down Access as well.
The "DoEvents" command is a part of the Application (VBA) standard commands.

Cheers
Chris
0
 
PeterBaileyUkAuthor Commented:
Thx for those additional comments.
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
I asked the Mods to remove my points because I didn't do anything to deserve them, and because my comment did not help to provide a solution. It was simply a request for more information.

And I assume you mean this question: http://www.experts-exchange.com/Database/MS_Access/Q_28638015.html when you posted this:

The previous id was a completely unrelated point that had been answered
It was about a different issue, but it then evolved into the issue here. In cases like this, you should direct the Expert efforts in the "other" question to here - so what you really should have done is told Chris that you had posted a new question, and worked the solution here.

And while you may disagree with me regarding policy, I'm certain that I'm right, regardless of what sort of suggestion you received from support. Had you closed out the "other" question, and continued working here, then there's no issue. But when you work the same issue in two questions - that's an EE no-no, regardless of who instructed you otherwise.

I'm sorry you feel I'm being "awkward". That's not really my intent.
0
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.

Join & Write a Comment

Featured Post

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.

  • 8
  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now