trigger onchange event in vba of website field

I have put data into the text field (search by serial) on this web page

http://www.bike-parts-honda.com/




I dont know how to trigger the onchange event of the website field in VBA Access code.
Private Sub SubmitVIN(strVIN As String)
    Dim i As Long
    Dim objElement As Object
 
 
 
    Set objCollection = IE.Document.getelementsbytagname("input")
 
    i = 0
'    loop around and look for input field and populate with data
    While i < objCollection.Length
        
        If objCollection(i).Name = "val11" Then
            ' Set text for search
            objCollection(i).Value = strVIN      'passed to this routine by main procedure
            
        End If
        
        
        i = i + 1
    Wend
    
'    now trigger on change event of input field
    
    ' Wait while IE re-loading...
    Do While IE.Busy
        DoEvents
    Loop
    
    ' Clean up
    Set objElement = Nothing

End Sub

Open in new window

PeterBaileyUkAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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.

Hans LangerCommented:
After populate the fields with vb call a javascript function with the following concepts:

if you are using jquery just use the .change() method:  
http://api.jquery.com/change/
$('input').each(function(){
$(this).change() //this will trigger the change event for each input in the page. you can use keypress,keyup,keydown,blur
})

Open in new window

If your are not using jquery you will need to do:
if ("createEvent" in document) {
    var evt = document.createEvent("HTMLEvents");
    evt.initEvent("change", false, true);
    element.dispatchEvent(evt);
}
else
    element.fireEvent("onchange");

Open in new window

or you can use:
<input type="text" id="field1" name="field1" value="1" onChange="myFunctionOnchange(this)" />
<script>
function myFunctionOnchange(input) {
  alert(input.name)
}
myFunctionOnchange(document.getElementById('field1'))
</script>

Open in new window



 you can use keypress, keyup, keydown, blur (when textbox loose focus).
PeterBaileyUkAuthor Commented:
The web page is not mine I want to populate a field with data from my db then do the equivalent of a submit, the page doesnt contain a submit button.  I guess I am not using jquery so is your second option the one i can insert into my access vba code?
Rainer JeschorCommented:
Hi,
perhaps the solution from the EE question solves your problem:
EE solution

HTH
Rainer
IT Pros Agree: AI and Machine Learning Key

We’d all like to think our company’s data is well protected, but when you ask IT professionals they admit the data probably is not as safe as it could be.

PeterBaileyUkAuthor Commented:
Yes I will have a read up on that and confirm in the morning it certainly looks promising
Hans LangerCommented:
Oh, I see, nevermind, I though you was posting ASP code. My bad
Hans LangerCommented:
Why don't you just create a http Get request to the page:

http://www.bike-parts-honda.com/verifidentification_v2_new.php?val1=CR&val2=UNITED%20KINGDOM

Then you parse and read the data from the result?
PeterBaileyUkAuthor Commented:
I wasnt sure how Hans
Hans LangerCommented:
Try this:
Sub GetList()
    Dim sSearchString As String
    sSearchString = "CR"
    
    'GETTING THE HTML CONTENT OF THE PAGE
    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    winHttpReq.SetTimeouts 0, 600000, 600000, 600000
    winHttpReq.Open "GET", "http://www.bike-parts-honda.com/verifidentification_v2_new.php?val1=" & sSearchString & "&val2=UNITED%20KINGDOM", False
    winHttpReq.Send
    Dim sHTML As String
    sHTML = winHttpReq.responseText
     
    
    
    'CLEANING AND FIXING NOT-WELL FORMED TAGS TO BE ABLE TO PROCESS IT IN AN XML DOM
    sHTML = "<xml>" & sHTML & "</xml>"
    sHTML = Replace(sHTML, "</A></span>", "")
    sHTML = Replace(sHTML, "</A>", "</a>")
    sHTML = Replace(sHTML, "<TR>", "<tr>")
    sHTML = Replace(sHTML, "<TD>", "<td>")
    sHTML = Replace(sHTML, "</TD>", "</td>")
    
    
    Dim objDOM As Object
    Set objDOM = CreateObject("Msxml2.DOMDocument.6.0")
    objDOM.LoadXML sHTML
    
    Dim oRow As Object
    
    ' READ ROW 1 BY 1
    For Each oRow In objDOM.SelectNodes("//tr[position()>1]")
        MsgBox "TradeName: " & oRow.SelectSingleNode("td[1]").Text & " - Pattern:" & oRow.SelectSingleNode("td[2]").Text & " - Country:" & oRow.SelectSingleNode("td[3]").Text
    Next
    
End Sub

Open in new window

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:
Ive added in the code to a routine in module1, I am not seeing the output message, it will return data with the code in the db currently for this test version 1 record, I need to save the data to a table.
PeterBaileyUkAuthor Commented:
If I can see where the return data is (i assume its in a block of html then I will be able to write it.
PeterBaileyUkAuthor Commented:
forgot to add a sample db
PeterBaileyUkAuthor Commented:
OK I can see now the document by printing sHTML.

The final 3 rows to read one by one are not working. I wondered now if regx can pick up the table data and save it. Here is what I have so far, although it doesnt pull anything out either

Private Sub SubmitVIN(strVIN As String)
Dim rsmc As Dao.Recordset
  Dim oRE As Object
  Dim strHTML As String
  Dim oM As Object
  
    Dim sSearchString As String
    
    sSearchString = strVIN
    
    
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    oRE.Pattern = "<tr>\s*<td>(\w[^<]*)</td>\s*<td>(\w[^<]*)</td>(?:.|\n)*?</tr>"
    Set rsmc = DBEngine(0)(0).OpenRecordset("TblModelLookup", dbOpenTable)
    
    
    
    'GETTING THE HTML CONTENT OF THE PAGE
    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    winHttpReq.SetTimeouts 0, 600000, 600000, 600000

    winHttpReq.Open "GET", "http://www.bike-parts-honda.com/verifidentification_v2_new.php?val1=" & sSearchString & "&val2=ALL%20COUNTRY", False
    winHttpReq.Send
    Dim sHTML As String
    sHTML = winHttpReq.responseText
     
    
    
    'CLEANING AND FIXING NOT-WELL FORMED TAGS TO BE ABLE TO PROCESS IT IN AN XML DOM
    sHTML = "<xml>" & sHTML & "</xml>"
    sHTML = Replace(sHTML, "</A></span>", "")
    sHTML = Replace(sHTML, "</A>", "</a>")
    sHTML = Replace(sHTML, "<TR>", "<tr>")
    sHTML = Replace(sHTML, "<TD>", "<td>")
    sHTML = Replace(sHTML, "</TD>", "</td>")
    
    
    Dim objDOM As Object
    Set objDOM = CreateObject("Msxml2.DOMDocument.6.0")
    objDOM.LoadXML sHTML
    Debug.Print sHTML
    Dim oRow As Object
    
    
    
    'parse the result
            If oRE.test(sHTML) Then
                Set oMatches = oRE.Execute(sHTML)
                For Each oM In oMatches
                    'push the data into the model table
                    rsmc.AddNew
                        rsmc!VehicleID = rsVINS!VRR_VehicleID
                        rsmc!vin = rsVINS!VinToUse
                        rsmc!TradeName = oM.submatches(0)
                        rsmc!Pattern = oM.submatches(1)
                        rsmc!Country = oM.submatches(2)
                        rsmc!StrYear = oM.submatches(3)
                        rsmc!TypeMine = oM.submatches(4)
                        rsmc!Misc1 = oM.submatches(5)
                        rsmc!Misc2 = oM.submatches(6)
                       
                        
                        
                        
                        
                        
                    rsmc.Update
                Next
            End If
    

    
    
    
    
    
    
    
    
    
    
    
    
    
    ' READ ROW 1 BY 1
    For Each oRow In objDOM.SelectNodes("//tr[position()>1]")
        MsgBox "TradeName: " & oRow.SelectSingleNode("td[1]").Text & " - Pattern:" & oRow.SelectSingleNode("td[2]").Text & " - Country:" & oRow.SelectSingleNode("td[3]").Text
    Next
    

    
    

End Sub

Open in new window

Hans LangerCommented:
you have 3 options:

- XML DOM:  fix the sHTML to be an XHTML (a valid XML) and then you work with XML DOM, with XPath. To validate that the XML use:
  Dim objDOM As Object
    Set objDOM = CreateObject("Msxml2.DOMDocument.6.0")
    objDOM.LoadXML sHTML
    If objDOM.DocumentElement Is Nothing Then
        MsgBox "The HTML document is not a valid XML"
        Exit Sub
    End If

' READ ROW 1 BY 1
    For Each oRow In objDOM.SelectNodes("//tr[position()>1]")
        MsgBox "TradeName: " & oRow.SelectSingleNode("td[1]").Text & " - Pattern:" & oRow.SelectSingleNode("td[2]").Text & " - Country:" & oRow.SelectSingleNode("td[3]").Text
    Next

Open in new window



-Regexp: Use 2 regular expression, one to extract row by row (tr), and another column by column (td). You will need to work on the regular expression because the HTML is not well formatted. I recommend you to copy the sHTML (or the source code of the page)  into this tool and start creating your regexp:

https://regex101.com/

- Strings Operators: the less efficient but still an option. Use "InStr" and others string operators to start reading the content from left to right.
PeterBaileyUkAuthor Commented:
I assume the second option will just slot into my code, i need the easiest and fastest solution processing wise.
PeterBaileyUkAuthor Commented:
The solution to the answer of the question has been covered anything else i can put to a regex question or vba question without breaking EE protocol.
PeterBaileyUkAuthor Commented:
woul;d you be happy hans for me to share the points with Rainer Jeschor too as he made a valid suggestion too?
Hans LangerCommented:
Sure, whatever you think it was useful for you deserve points :D.
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
JavaScript

From novice to tech pro — start learning today.