msxmlhttp and post paramaters

murdytherp

New Member
Joined
Jan 3, 2014
Messages
11
Good evening,

Following a suggestion on another thread, i've been using vba with ie document to parse javascript form results
Rich (BB code):
Dim IE As InternetExplorer
Sub Update_Price()
    Application.ScreenUpdating = False
    
    Set IE = New InternetExplorer
    Set rng = ActiveCell
        
    IE.Visible = False
    IE.Navigate "WebFLIS - Public Search"
    
    Application.StatusBar = "Submitting"
    ' Wait while IE loading...
    
    Do While (IE.Busy Or IE.readyState <> 4)
    DoEvents
    Loop
    
    ' **********************************************************************
    ' checkboxes and "clear all" ... C1,C3,C6,C4,C7,C9,C14,Submit  (in order top to bottom)
    IE.document.getelementbyid("txtNiin").Value = rng
    IE.document.getelementbyid("btnNIIN").Click
  
    '**********************************************************************
    
    Do While (IE.Busy Or IE.readyState <> 4)
    DoEvents
    Loop
With IE.document.getelementbyid("lblItemName")
ActiveCell.Offset(0, -1).Value = .innertext
End With
With IE.document.getelementbyid("Datagrid19")
        For x = 0 To .Rows.Length - 1
            For y = 0 To .Rows(x).Cells.Length - 1
                ActiveCell.Offset(0, 2).Value = .Rows(1).Cells(5).innertext
                ActiveCell.Offset(0, 1).Value = .Rows(1).Cells(4).innertext
            Next y
        Next x
    End With

    Application.StatusBar = "Form Submitted"
    Set IE = Nothing
    Set NSN = Nothing
    Application.ScreenUpdating = True
End Sub

This works for single files, but when placed in a loop hangs and crashes my computer after about 70 iterations

Searching for a solution pointed me to use MSXMLHTTP and HTMLHTTP with the latter being blocked by system administrator. Following the example, I've come up with
Rich (BB code):
Public Sub openWebsite()
    
    Dim oXmlHttp As Object
    Dim btNiin As String, txtNiin As String, PostData As String, C1 As String, C3 As String, C6 As String, C7 As String, C9 As String, C14 As String, url As String
    Dim txtMultipleNiin As String, txtKeyword As String, txtPART As String, txtManName As String, txtManPartNum As String, txtCAGE As String
    
        
    'Website Options
    
    btnNiin = "submit"
    txtNiin = "9925-01-305-3411"
    txtMultipleNiin = "" '].value = "";
    txtKeyword = "" '].value = "";
    txtPART = "" '].value = "";
    txtManName = "" '].value = "";
    txtManPartNum = "" '].value = "";
    txtCAGE = "" '].value = "";
    C1 = "" 'type checked for checked
    C3 = "" 'type checked for checked
    C6 = "" 'type checked for checked
    C4 = "Checked" 'Management type checked for checked
    C7 = "" 'type checked for checked
    C9 = "" 'Freight Data type checked for checked
    C14 = "" 'type checked for checked
    PostData = "txtNiin=" & txtNiin & "C1=" & C1 & "C3=" & C3 & "C6=" & C6 & "C4=" & C4 & "C7=" & C7 & "C9=" & C9 & "C14=" & C14 & "txtMultipleNiin=" & txtMultipleNiin & "txtKeyword=" & txtKeyword & "txtPART=" & txtPART & "txtManName=" & txtManName & "txtManPartNum=" & txtManPartNum & "txtCAGE=" & txtCAGE
    url = "WebFLIS - Public Search"
    
    
    
    Set oXmlHttp = CreateObject("MSXML2.XMLHTTP")
    
    oXmlHttp.Open "Post", url, False
    oXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oXmlHttp.send (PostData)

    Dim oHtmlObj As Object
    Set oHtmlObj = CreateObject("htmlfile")
    oHtmlObj.body.innerHTML = oXmlHttp.responseText
    Debug.Print oXmlHttp.responseText
End Sub

It does not work. I tried just the "txtNiin=" & txtNiin and it still does not work. The end result is the hard coded number will be a variable and I'll parse the results, but I can't even get the hard coded number to post to the page. It does submit something and returns something strange (see oXMLhttp.responseText).

Thank you in advance for your help
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
What am I doing wrong?

I used Fiddler to see what was posted and responded and received this response:
Rich (BB code):
Accept-Language: en-us
Content-Type: application/x-www-form-urlencoded
UA-CPU: x86
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET CLR 3.0.04506.648; .NET CLR 3.5.21022; InfoPath.2; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729; .NET4.0C; .NET4.0E)
Proxy-Connection: Keep-Alive
Content-Length: 970
Host: www.dlis.dla.mil
Pragma: no-cache
Cookie: BC_HA_514ad30dba4cf40c_3B77607C=83A27; BC_HA_7faa9e2b648df6c0_3B77607C=10A745; BCSI-CS-903441b96822092a=2; BCSI-CS-514ad30dba4cf40c=2; BCSI-CS-b01661e9211dd818=2; BCSI-CS-6563ebbd57af098c=2
__LASTFOCUS=
&__VIEWSTATE=%2FwEPDwULLTEyODI3NTg3OTMPZBYCAgIPZBYkAgcPZBYCAgEPPCsACwBkAggPZBYCAgMPPCsACwBkAgkPZBYCAgEPPCsACwBkAgoPZBYCAgEPPCsACwBkAgsPZBYCAgEPPCsACwBkAgwPZBYCAgEPPCsACwBkAg0PZBYCAgMPPCsACwBkAg4PZBYCAgEPPCsACwBkAg8PZBYCAgMPPCsACwBkAhAPZBYEAgMPPCsACwBkAgUPPCsACwBkAhEPZBYCAgEPPCsACwBkAhIPZBYCAgEPPCsACwBkAhMPZBYCAgkPPCsACwBkAhQPZBYCAgUPPCsACwBkAhUPZBYCAgcPPCsACwBkAhYPZBYCAgUPPCsACwBkAhcPZBYCAgUPPCsACwBkAhgPZBYCAgUPPCsACwBkGAEFHl9fQ29udHJvbHNSZXF1aXJlUG9zdEJhY2tLZXlfXxYJBRFjaGtFeHBhbmRlZFNlYXJjaAUHY2hrQ2FnZQUCQzEFAkMzBQJDNgUCQzQFAkM3BQJDOQUDQzE0Hg4HtWCJBCv91s96GsNVwS1t3Qo%3D
&__VIEWSTATEGENERATOR=E69BC198
&__EVENTTARGET=
&__EVENTARGUMENT=
&__EVENTVALIDATION=%2FwEWEQLjyKz%2BBQLDkqnvDQLHkL%2B1AgK%2BsdPcCAK54Yr1AQLIhLeDDAKE3r2bCAK%2B61kC3v3%2B%2FgsC4a%2BaDQLd7%2BbtDALd797tDALd79LtDALd79rtDALd787tDALd74buDALj04CPBOalyQAKB3uBnSqURBdKzj7TSnrm
&txtNiin=9925-01-305-3411
&btnNIIN=Go
&txtKeyword=
&txtPART=
&txtCAGE=
&txtManName=
&txtManPartNum=
&C1=on
&C6=on
&C4=on
&C14=on

I then adjusted my VBA code to
Rich (BB code):
Public Sub openWebsite(strOpenMethod As String, strURL As String, Optional strPostData As String)
    Dim pXmlHttp As Object
    Set pXmlHttp = CreateObject("MSXML2.XMLHTTP")
    pXmlHttp.Open strOpenMethod, strURL, False
    pXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    pXmlHttp.send (strPostData)

    Dim pHtmlObj As Object
    Set pHtmlObj = CreateObject("htmlfile")
    pHtmlObj.body.innerHTML = pXmlHttp.responseText
    
    Debug.Print pHtmlObj.body.innerHTML
    Application.StatusBar = "Form Submitted"
    Application.ScreenUpdating = True
End Sub
Sub test()
    Dim strLASTFOCUS As String, strEVENTTARGET As String, strEVENTARGUMENT As String, strEVENTVALIDATION As String, strVIEWSTATE As String, strVIEWSTATEGENERATOR As String, strtxtNiin As String, strbtnNIIN As String, StrC1 As String, strC3 As String, strC4 As String, strC6 As String, strC7 As String, strC9 As String, strC14 As String, PostData As String
    strLASTFOCUS = ""
    strVIEWSTATE = "%2FwEPDwULLTEyODI3NTg3OTMPZBYCAgIPZBYkAgcPZBYCAgEPPCsACwBkAggPZBYCAgMPPCsACwBkAgkPZBYCAgEPPCsACwBkAgoPZBYCAgEPPCsACwBkAgsPZBYCAgEPPCsACwBkAgwPZBYCAgEPPCsACwBkAg0PZBYCAgMPPCsACwBkAg4PZBYCAgEPPCsACwBkAg8PZBYCAgMPPCsACwBkAhAPZBYEAgMPPCsACwBkAgUPPCsACwBkAhEPZBYCAgEPPCsACwBkAhIPZBYCAgEPPCsACwBkAhMPZBYCAgkPPCsACwBkAhQPZBYCAgUPPCsACwBkAhUPZBYCAgcPPCsACwBkAhYPZBYCAgUPPCsACwBkAhcPZBYCAgUPPCsACwBkAhgPZBYCAgUPPCsACwBkGAEFHl9fQ29udHJvbHNSZXF1aXJlUG9zdEJhY2tLZXlfXxYJBRFjaGtFeHBhbmRlZFNlYXJjaAUHY2hrQ2FnZQUCQzEFAkMzBQJDNgUCQzQFAkM3BQJDOQUDQzE0Hg4HtWCJBCv91s96GsNVwS1t3Qo%3D"
    strVIEWSTATEGENERATOR = "E69BC198"
    strEVENTTARGET = ""
    strEVENTARGUMENT = ""
    strEVENTVALIDATION = "%2FwEWEQLjyKz%2BBQLDkqnvDQLHkL%2B1AgK%2BsdPcCAK54Yr1AQLIhLeDDAKE3r2bCAK%2B61kC3v3%2B%2FgsC4a%2BaDQLd7%2BbtDALd797tDALd79LtDALd79rtDALd787tDALd74buDALj04CPBOalyQAKB3uBnSqURBdKzj7TSnrm"
    strtxtNiin = "9925-01-305-3411"
    strbtnNIIN = "Go"
    StrC1 = "On" 'Item Identification Data
    strC3 = "" 'MOE Rule Coded Data
    strC4 = "On" 'Management Data
    strC6 = "On" 'Ref/PN Data
    strC7 = "" 'Phrase Data
    strC9 = "" 'Freight Data
    strC14 = "On" 'Characteristics Decoded Data
    PostData = "__LASTFOCUS=" & strLASTFOCUS & "__EVENTTARGET=" & strEVENTTARGET & "__EVENTARGUMENT=" & strEVENTARGUMENT & "__EVENTVALIDATION=" & strEVENTVALIDATION & "__VIEWSTATE=" & strVIEWSTATE & "__VIEWSTATEGENERATOR=" & strVIEWSTATEGENERATOR & "txtNiin=" & strtxtNiin & "btnNIIN=" & strbtnNIIN & "C1=" & StrC1 & "C6=" & strC6 & "C4=" & strC4 & "C14=" & strC14
    openWebsite "POST", "WebFLIS - Public Search", PostData
End Sub

It's just not working. I don't understand what's going on.
 
Upvote 0
Three things:

1. You must separate the 2nd and subsequent parameter=value pairs with an ampersand character (&), something like this (code amended for the first 2 pairs only):
Code:
    PostData = "__LASTFOCUS=" & strLASTFOCUS & "&__EVENTTARGET=" & strEVENTTARGET & "&__EVENTARGUMENT=" & strEVENTARGUMENT & "__EVENTVALIDATION=" & strEVENTVALIDATION & "__VIEWSTATE=" & strVIEWSTATE & "__VIEWSTATEGENERATOR=" & strVIEWSTATEGENERATOR & "txtNiin=" & strtxtNiin & "btnNIIN=" & strbtnNIIN & "C1=" & StrC1 & "C6=" & strC6 & "C4=" & strC4 & "C14=" & strC14

2. Certain characters are invalid in URL parameter names and values so you must URL-encode them. See How can I URL encode a string in Excel VBA? - Stack Overflow or the Escape function at VBA web services. The code then becomes (again I've changed only the first 2 parameters to show the idea):
Code:
    PostData = "__LASTFOCUS=" & Escape(strLASTFOCUS) &  "&__EVENTTARGET=" & Escape(strEVENTTARGET) & "&__EVENTARGUMENT="  & strEVENTARGUMENT & "&__EVENTVALIDATION=" &  strEVENTVALIDATION & "__VIEWSTATE=" & strVIEWSTATE &  "__VIEWSTATEGENERATOR=" & strVIEWSTATEGENERATOR & "txtNiin="  & strtxtNiin & "btnNIIN=" & strbtnNIIN & "C1=" &  StrC1 & "C6=" & strC6 & "C4=" & strC4 & "C14=" &  strC14

3. The VIEWSTATE, EVENTVALIDATION, etc. parameter values are likely to be valid only for your Fiddler session and may be rejected by the web server when the same values are submitted by your VBA program. Therefore you should request the current values of these parameters using a XMLhttp GET request and extract their values from the response using HTMLDocument.getElementById method.
 
Upvote 0
I'm so glad you responded, I was just searching how to close this thread.

After watching Fidler I finally made my file look exactly like a normal request. I thought I was done with the retrieval process and then on to parsing, but your number 3 tells me im wrong. (insert man banging head against desk here)

Rich (BB code):
Public Sub openWebsite(strOpenMethod As String, strURL As String, Optional strPostData As String)
    Dim pXmlHttp As Object
    Set pXmlHttp = CreateObject("MSXML2.XMLHTTP")
    pXmlHttp.Open strOpenMethod, strURL, False
    pXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    pXmlHttp.send (strPostData)
    Dim pHtmlObj As Object
    Set pHtmlObj = CreateObject("htmlfile")
    pHtmlObj.body.innerHTML = pXmlHttp.responseText
    
    Debug.Print pHtmlObj.body.innerHTML
    Application.StatusBar = "Form Submitted"
    Application.ScreenUpdating = True
End Sub
Sub test()
    Dim strVIEWSTATE As String, strEVENTVALIDATION As String, strtxtNiin As String, PostData As String
    strVIEWSTATE = "%2FwEPDwULLTEyODI3NTg3OTMPZBYCAgIPZBYkAgcPZBYCAgEPPCsACwBkAggPZBYCAgMPPCsACwBkAgkPZBYCAgEPPCsACwBkAgoPZBYCAgEPPCsACwBkAgsPZBYCAgEPPCsACwBkAgwPZBYCAgEPPCsACwBkAg0PZBYCAgMPPCsACwBkAg4PZBYCAgEPPCsACwBkAg8PZBYCAgMPPCsACwBkAhAPZBYEAgMPPCsACwBkAgUPPCsACwBkAhEPZBYCAgEPPCsACwBkAhIPZBYCAgEPPCsACwBkAhMPZBYCAgkPPCsACwBkAhQPZBYCAgUPPCsACwBkAhUPZBYCAgcPPCsACwBkAhYPZBYCAgUPPCsACwBkAhcPZBYCAgUPPCsACwBkAhgPZBYCAgUPPCsACwBkGAEFHl9fQ29udHJvbHNSZXF1aXJlUG9zdEJhY2tLZXlfXxYJBRFjaGtFeHBhbmRlZFNlYXJjaAUHY2hrQ2FnZQUCQzEFAkMzBQJDNgUCQzQFAkM3BQJDOQUDQzE0Hg4HtWCJBCv91s96GsNVwS1t3Qo%3D"
    strEVENTVALIDATION = "%2FwEWEQLjyKz%2BBQLDkqnvDQLHkL%2B1AgK%2BsdPcCAK54Yr1AQLIhLeDDAKE3r2bCAK%2B61kC3v3%2B%2FgsC4a%2BaDQLd7%2BbtDALd797tDALd79LtDALd79rtDALd787tDALd74buDALj04CPBOalyQAKB3uBnSqURBdKzj7TSnrm"
    strtxtNiin = "9925-01-305-3411"
    'StrC1 = "On" 'Item Identification Data
    'C3 = "" 'MOE Rule Coded Data
    'C4 = "On" 'Management Data
    'C6 = "On" 'Ref/PN Data
    'C7 = "" 'Phrase Data
    'C9 = "" 'Freight Data
    'C14 = "On" 'Characteristics Decoded Data
    PostData = "__LASTFOCUS=" & strLASTFOCUS & "&__VIEWSTATE=" & strVIEWSTATE & "&__VIEWSTATEGENERATOR=E69BC198" & "&__EVENTTARGET=" & "&__EVENTARGUMENT=" & "&__EVENTVALIDATION=" & strEVENTVALIDATION & "&txtNiin=" & strtxtNiin & "&btnNIIN=Go" & "&txtKeyword=" & "&txtPART=" & "&txtCAGE=" & "&txtManName" & "&txtManPartNum" & "&C1=on" & "&C6=on" & "&C4=on" & "&C14=on"
    openWebsite "POST", "WebFLIS - Public Search", PostData
End Sub

the above code actually retrieves the webpage, but I'm assuming your right. So two questions:
So how do I perform a xmlhttp Get request?
Also, I tried pXmlHttp.getelementbyid("lblItemName"), is there a different syntax for extracting responsetext?
 
Upvote 0
Thank you John and jsotola. You two have been exceptionally helpful and I now have a working product. 712 records in 15 minutes.

Rich (BB code):
Sub Update_All_NSNs()
    Dim rng As Range
    Dim cel As Range
    Dim iReply As Byte, iType As Integer
' Define buttons argument.
      iType = vbYesNo + vbCritical + vbDefaultButton2
        iReply = MsgBox("Warning, this update requires a steady internet connection and will take longer than 15 minutes.  You may update individual prices by selecting the NSN and clicking Update Individual NSN.  Are you sure you want to update all prices?", _
                        iType)
            If iReply = vbNo Then GoTo Line1 Else
          
    
    Set rng = Range("NSN")
    
    Dim strtxtNiin As String
    For Each cel In Range("NSN")
        strtxtNiin = cel.Value
      
    'Validator Variables
        Dim vHtmlObj As HTMLDocument
        Dim vXmlHttp As Object, objVS As Object, objEV As Object, objVSGen As Object
        Dim strVIEWSTATE As String, strEVENTVALIDATION As String, strURL As String
    'Urlencode Variables
        
    'Web Query Variables
        Dim strPostData As String 'Web Query Strings
        Dim pXmlHttp As Object
       
    'Parse Variables
        Dim lblItemName As Object, Datagrid19 As Object
        
    
    strURL = "WebFLIS - Public Search"
    
    'Data Validation information
        Set vXmlHttp = CreateObject("MSXML2.XMLHTTP")
        vXmlHttp.Open "GET", strURL, False
        vXmlHttp.send
        Set vHtmlObj = CreateObject("htmlfile")
        vHtmlObj.body.innerHTML = vXmlHttp.responseText
        Set objVS = vHtmlObj.getElementById("__VIEWSTATE")
        Set objEV = vHtmlObj.getElementById("__EVENTVALIDATION")
        Set objVSGen = vHtmlObj.getElementById("__VIEWSTATEGENERATOR")
        strVIEWSTATE = objVS.Value
        strEVENTVALIDATION = objEV.Value
        strVIEWSTATEGENERATOR = objVSGen.Value
        
    
    'URL Encode ViewState
        Dim ScriptEngine As ScriptControl
        Set ScriptEngine = New ScriptControl
        ScriptEngine.Language = "JScript"
        ScriptEngine.AddCode "function encode(strViewstate) {return encodeURIComponent(strViewstate);}"
        Dim encoded As String
        encoded = ScriptEngine.Run("encode", strVIEWSTATE)
        strVIEWSTATE = encoded
    'URL Encode Event Validation
        ScriptEngine.AddCode "function encode(strEVENTVALIDATION) {return encodeURIComponent(strEVENTVALIDATION);}"
        encoded = ScriptEngine.Run("encode", strEVENTVALIDATION)
        strEVENTVALIDATION = encoded
    'URL Encode ViewState Generator
        ScriptEngine.AddCode "function encode(strVIEWSTATEGENERATOR) {return encodeURIComponent(strVIEWSTATEGENERATOR);}"
        encoded = ScriptEngine.Run("encode", strVIEWSTATEGENERATOR)
        strVIEWSTATEGENERATOR = encoded
        
    
    
    'Web Query Scrape
        'strtxtNiin = InputBox("Enter Niin", , "9925-01-326-2855")
        strPostData = "__LASTFOCUS=" & "&__VIEWSTATE=" & strVIEWSTATE & "&__VIEWSTATEGENERATOR=" & strVIEWSTATEGENERATOR & "&__EVENTTARGET=" & "&__EVENTARGUMENT=" & "&__EVENTVALIDATION=" & strEVENTVALIDATION & "&txtNiin=" & strtxtNiin & "&btnNIIN=Go" & "&txtKeyword=" & "&txtPART=" & "&txtCAGE=" & "&txtManName=" & "&txtManPartNum=" & "&C1=on" & "&C4=on"
            'C1 = "On" 'Item Identification Data
            'C3 = "" 'MOE Rule Coded Data
            'C4 = "On" 'Management Data
            'C6 = "On" 'Ref/PN Data
            'C7 = "" 'Phrase Data
            'C9 = "" 'Freight Data
            'C14 = "On" 'Characteristics Decoded Data
  
     
        Set pXmlHttp = CreateObject("MSXML2.XMLHTTP")
        pXmlHttp.Open "Post", strURL, False
        pXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        pXmlHttp.send (strPostData)
        Dim pHtmlObj As HTMLDocument
        Set pHtmlObj = CreateObject("htmlfile")
        pHtmlObj.body.innerHTML = pXmlHttp.responseText
    'Parse Data Information
        Set lblItemName = pHtmlObj.getElementById("lblItemName")
        If lblItemName Is Nothing Then GoTo Line2 Else
            cel.Offset(0, 1).Value = lblItemName.innerText
        Set Datagrid19 = pHtmlObj.getElementById("Datagrid19")
        With Datagrid19
        For x = 0 To .Rows.Length - 1
            For y = 0 To .Rows(x).Cells.Length - 1
                cel.Offset(0, 3).Value = .Rows(1).Cells(5).innerText
                cel.Offset(0, 2).Value = .Rows(1).Cells(4).innerText
            Next y
        Next x
        End With
        cel.Offset(0, 5) = Date
        

Line2:
        Next cel
Line1:
MsgBox "Update complete"
End Sub

This works, I'm very happy. However, if you know of a way to make it better, please let me know.
 
Upvote 0

Forum statistics

Threads
1,215,110
Messages
6,123,138
Members
449,098
Latest member
Doanvanhieu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top