Search code examples
excelvbaweb-scrapingxmlhttprequest

Post data works in postman not in VBA

I am trying to get some data based on search items. Example in worksheet "Main" in A2 284112500592.. In a text file in the same path of the workbook, I put this postData information like that

ctl00$ctl61$g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3$ctl00$txtCivilID:↵:270022102796
__VIEWSTATE:/wEPDwUBMA9kFgJmD2QWAgIBD2QWBgIBD2QWBAIGD2QWAmYPZBYCAgMPFgIeE1ByZXZpb3VzQ29udHJvbE1vZGULKYgBTWljcm9zb2Z0LlNoYXJlUG9pbnQuV2ViQ29udHJvbHMuU1BDb250cm9sTW9kZSwgTWljcm9zb2Z0LlNoYXJlUG9pbnQsIFZlcnNpb249MTYuMC4wLjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49NzFlOWJjZTExMWU5NDI5YwFkAhIPZBYCAgMPZBYCZg9kFgJmDzwrAAYAZAIFD2QWCgIBD2QWAgIBD2QWAgUmZ19jY2E0MzE1Nl9kMzNhXzRlZjFfODc4Ml8yYzNjN2E0ZWVhZjMPZBYCZg9kFggCAQ8PFgIeBFRleHQFF9in2YTYsdmC2YUg2KfZhNmF2K/ZhtmKZGQCBQ8PFgIfAQUO2KfYs9iq2LnZhNin2YVkZAIHDxYCHgdWaXNpYmxlZxYCAgEPDxYCHwEF6ALYrdiz2Kgg2LPYrNmE2KfYqtmG2Kcg2Iwg2KrZiNis2K8g2KjYrdmI2LLYqtmDINio2LfYp9mC2Kkg2LXYp9mE2K3YqSDYjCDZiNmE2KfZitmI2KzYryDYt9mE2Kgg2KzYr9mK2K8g2YjZhNmD2YYg2KXYsNinINmD2YbYqiDZgtivINiq2YLYr9mF2Kog2KjYt9mE2Kgg2KzYr9mK2K8g2YTYqti62YrZitixINin2YTYudmG2YjYp9mGINij2Ygg2KfZhNi12YjYsdipINij2Ygg2LrZitixINiw2YTZgyDZgdmK2LHYrNmJINil2LnYp9iv2Kkg2KfZhNmF2K3Yp9mI2YTYqSDZhNin2K3ZgtinIFwg2YrYsdis2Ykg2KrZgdi52YrZhCDYqNi32KfZgtiq2YMg2KfZhNmF2K/ZhtmK2Kkg2YXZhiDYrtmE2KfZhCDYqti32KjZitmCINmH2YjZitiq2YpkZAIJDw8WAh8BBXHZh9iw2Ycg2KfZhNiu2K/ZhdipINmF2KrZiNmB2LHYqSDYo9mK2LbYpyDYudmE2Ykg2YbYuNin2YUg2KfZhNin2LPYqti52YTYp9mFINin2YTYtdmI2KrZiiDZh9in2KrZgSDYsdmC2YUgMTg4OTk4OGRkAgcPZBYCAgEPZBYCAgIPZBYCAgEPZBYCAgMPFgIfAmgWAmYPZBYEAgMPZBYGAgEPFgIfAmhkAgMPFgIfAmhkAgUPFgIfAmhkAgQPDxYCHglBY2Nlc3NLZXkFAS9kZAIJD2QWAmYPZBYIZg8PFgIfAQUh2KfZhNij2LPYptmE2Kkg2KfZhNmF2KrYr9in2YjZhNipFgIeBGhyZWYFPmh0dHBzOi8vd3d3LmUuZ292Lmt3L3NpdGVzL2tnb0FyYWJpYy9QYWdlcy9JbmZvUGFnZXMvRkFRcy5hc3B4ZAICDw8WAh8BBRfYrtix2YrYt9ipINin2YTZhdmI2YLYuRYCHwQFQWh0dHBzOi8vd3d3LmUuZ292Lmt3L3NpdGVzL2tnb0FyYWJpYy9QYWdlcy9JbmZvUGFnZXMvU2l0ZW1hcC5hc3B4ZAIEDw8WAh8BBQ/Yp9iq2LXZhCDYqNmG2KcWAh8EBUNodHRwczovL3d3dy5lLmdvdi5rdy9zaXRlcy9rZ29BcmFiaWMvUGFnZXMvQ29udGFjdFVTL0NvbnRhY3RVcy5hc3B4ZAIGDw8WAh8BBQdFbmdsaXNoZGQCCw9kFgJmD2QWAmYPDxYCHwEFEzAyINmK2YjZhNmK2YcsIDIwMjBkZAIND2QWAgICD2QWAgIBDxYCHwALKwQBZAIUD2QWAgIBDxYCHwALKwQBZGT1yYetu3GdUJMTDFq+LkJBUlBeyGjwxMJQkogPv054tQ==

And set the header to be Content-Type and the value [{"key":"Content-Type","value":"application/x-www-form-urlencoded","description":"","type":"text","enabled":true}] When trying that on postman I got a response like that

<div class="alert">
                                        <span id="ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult" class="labelText">حسب سجلاتنا ، توجد بحوزتك بطاقة صالحة ، ولايوجد طلب جديد ولكن إذا كنت قد تقدمت بطلب جديد لتغيير العنوان أو الصورة أو غير ذلك فيرجى إعادة المحاولة لاحقا \ يرجى تفعيل بطاقتك المدنية من خلال تطبيق هويتي</span>
                                        </div>

This is the response which I expect .. But when applying that to the code, it didn't work and I got error at the final part which is supposed to extract the information I need

Sub Test()
    Dim http        As New XMLHTTP60
    Dim html        As New HTMLDocument
    Dim ws          As Worksheet
    Dim myUrl       As String
    Dim postData    As String
    Dim r           As Long

    Set ws = ThisWorkbook.Worksheets("Main")
            'https://www.e.gov.kw/sites/kgoArabic/Pages/eServices/PACI/CivilIDStatus.aspx
    myUrl = "https://www.e.gov.kw/sites/kgoArabic/Pages/eServices/PACI/CivilIDStatus.aspx"

    For r = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    '--------
        Dim f, s, m(1)
    f = ThisWorkbook.Path & "\FormData.txt":  If Dir(f) = "" Then Beep: Exit Sub
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8":  .Open:  .LoadFromFile f:  f = .ReadText:  .Close
    End With
''''''''------------
    postData = f
    
        'postData = ThisWorkbook.Worksheets("DB").Range("J1").Value
        'postData = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value 'CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\FormData.txt").ReadAll
        'ActiveCell.Value = postData
        
        'postData = Replace(postData, "270022102796", CStr(ws.Cells(r, 1).Value))

        With http
            .Open "POST", myUrl, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send postData
            'Application.Wait Now + TimeValue("00:00:03")
            html.body.innerHTML = .responseText
                     'ExportHTML .responseText
                     'ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult
                     
                     
                                                       'ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult
                                                       
            'Debug.Print html.getElementById("ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblGeneralMsg").innerText
                                            'ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult
                                            
             'ERROR HERE ..
            Debug.Print html.querySelector("#ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult").innerText
            ws.Cells(r, 4).Value = html.getElementById("ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult").innerText
        End With
    Next r
End Sub

I tried to get the VIEWSTATE through the code like that but the same problem

Sub Test2()
    Const sURL = "https://www.e.gov.kw/sites/kgoArabic/Pages/eServices/PACI/CivilIDStatus.aspx"
    Dim http As New XMLHTTP60, html As New htmlDocument, posts As Object, post As Object, elem As Object, postData As String, req1 As String, req2 As String, x As Long
    With http
        .Open "POST", sURL, False
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
        .send
        html.body.innerHTML = .responseText
    End With
    Set posts = html.getElementById("__VIEWSTATE")
    req1 = WorksheetFunction.EncodeURL(posts.Value)
    Set post = html.getElementById("__EVENTVALIDATION")
    req2 = WorksheetFunction.EncodeURL(post.Value)
    'postData = CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\FormData.txt").ReadAll
    '----------
            Dim f, s, m(1)
    f = ThisWorkbook.Path & "\FormData.txt":  If Dir(f) = "" Then Beep: Exit Sub
    With CreateObject("ADODB.Stream")
        .CharSet = "UTF-8":  .Open:  .LoadFromFile f:  f = .ReadText:  .Close
    End With
''''''''------------
    postData = f
    postData = Replace(Replace(Replace(postData, "XXXX", req1), "YYYY", req2), "ZZZZ", "270022102796")
    
    With http
        .Open "POST", sURL, False
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
        .send postData
        html.body.innerHTML = .responseText
        ExportHTML .responseText
    End With
    Debug.Print html.querySelector("#ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult").innerText
    Stop
End Sub

Sub ExportHTML(sInput As String)
    With CreateObject("ADODB.Stream")
        .CharSet = "UTF-8"
        .Open
        .WriteText sInput
        .SaveToFile Environ("USERPROFILE") & "\Desktop\OutputHTML.html", 2
        .Close
    End With
End Sub
Solution

  • I could figure it out in that way .. But if there is a way to improve the speed of the code, I would appreciate that a lot. As the code considers opening the URL twice not only once

    Sub DemoNew()
    Const sURL = "https://www.e.gov.kw/sites/kgoArabic/Pages/eServices/PACI/CivilIDStatus.aspx"
    'New XMLHTTP60
    Dim http As New XMLHTTP60, html As New HTMLDocument, posts As Object, post As Object, elem As Object, postData As String, req1 As String, req2 As String, req3 As String, x As Long
    Dim r As Long
    Dim strID As String
    For r = 2 To 6
    strID = Cells(r, 1).Value
    With http
        .Open "POST", sURL, False
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
        .send
        html.body.innerHTML = .responseText
    End With
    Set posts = html.getElementById("__VIEWSTATE")
    req1 = WorksheetFunction.EncodeURL(posts.Value)
    Set post = html.getElementById("__EVENTVALIDATION")
    req3 = WorksheetFunction.EncodeURL(post.Value)
    req2 = WorksheetFunction.EncodeURL(html.getElementById("__VIEWSTATEGENERATOR").Value)
    'Stop
    'postData = CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\FormData.txt").ReadAll
    '----------
'            Dim f, s, m(1)
'    f = ThisWorkbook.Path & "\FormData.txt":  If Dir(f) = "" Then Beep: Exit Sub
'    With CreateObject("ADODB.Stream")
'        .CharSet = "UTF-8":  .Open:  .LoadFromFile f:  f = .ReadText:  .Close
'    End With
''''''''------------
    'postData = f
    Rem VIP postData = "_wpcmWpid=&wpcmVal=&MSOWebPartPage_PostbackSource=&MSOTlPn_SelectedWpId=&MSOTlPn_View=0&MSOTlPn_ShowSettings=False&MSOGallery_SelectedLibrary=&MSOGallery_FilterString=&MSOTlPn_Button=none&__EVENTTARGET=&__EVENTARGUMENT=&__REQUESTDIGEST=0xA3BDFC0EF1EF14D4C44BC4ECBAC447062B50319C5912BA08F10FD8A0F3870D6E6DB33AC517D311D698C1BDCFDDF840D7048531FFEE481C1272701820189DCA4E%2C02+Jul+2020+16%3A58%3A19+-0000&MSOSPWebPartManager_DisplayModeName=Browse&MSOSPWebPartManager_ExitingDesignMode=false&MSOWebPartPage_Shared=&MSOLayout_LayoutChanges=&MSOLayout_InDesignMode=&_wpSelected=&_wzSelected=&MSOSPWebPartManager_OldDisplayModeName=Browse&MSOSPWebPartManager_StartWebPartEditingName=false&MSOSPWebPartManager_EndWebPartEditing=false&__VIEWSTATE=XXXX&__VIEWSTATEGENERATOR=YYYY&__EVENTVALIDATION=ZZZZ&ctl00%24ctl61%24g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3%24ctl00%24txtCivilID=NNNN&ctl00%24ctl61%24g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3%24ctl00%24btnSearch=%D8%A7%D8%B3%D8%AA%D8%B9%D9%84%D8%A7%D9%85"
    postData = "_wpcmWpid=&wpcmVal=&MSOWebPartPage_PostbackSource=&MSOTlPn_SelectedWpId=&MSOTlPn_View=0&MSOTlPn_ShowSettings=False&MSOGallery_SelectedLibrary=&MSOGallery_FilterString=&MSOTlPn_Button=none&__EVENTTARGET=&__EVENTARGUMENT=&__REQUESTDIGEST=&MSOSPWebPartManager_DisplayModeName=Browse&MSOSPWebPartManager_ExitingDesignMode=false&MSOWebPartPage_Shared=&MSOLayout_LayoutChanges=&MSOLayout_InDesignMode=&_wpSelected=&_wzSelected=&MSOSPWebPartManager_OldDisplayModeName=Browse&MSOSPWebPartManager_StartWebPartEditingName=false&MSOSPWebPartManager_EndWebPartEditing=false&__VIEWSTATE=XXXX&__VIEWSTATEGENERATOR=YYYY&__EVENTVALIDATION=ZZZZ&ctl00%24ctl61%24g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3%24ctl00%24txtCivilID=NNNN&ctl00%24ctl61%24g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3%24ctl00%24btnSearch=%D8%A7%D8%B3%D8%AA%D8%B9%D9%84%D8%A7%D9%85"
    '270022102796
    
    postData = Replace(Replace(Replace(Replace(postData, "XXXX", req1), "YYYY", req2), "ZZZZ", req3), "NNNN", strID)
    
    Rem VIP postData = Replace(Replace(Replace(Replace(postData, "XXXX", req1), "YYYY", req2), "ZZZZ", req3), "NNNN", strID)
    Rem ActiveCell.Value = postData
    With http
        .Open "POST", sURL, False
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
        .send postData
        html.body.innerHTML = .responseText
        'ExportHTML .responseText
    End With
    Cells(r, 4).Value = html.querySelector("#ctl00_ctl61_g_cca43156_d33a_4ef1_8782_2c3c7a4eeaf3_ctl00_lblResult").innerText
    'Stop
    Next r
End Sub