邮政数据在邮递员中工作，而不是在 VBA 中答案

【问题标题】：Post data works in postman not in VBA邮政数据在邮递员中工作，而不是在 VBA 中
【发布时间】：2020-10-23 04:32:03
【问题描述】：

我正在尝试根据搜索项获取一些数据。 A2 284112500592.. 中的工作表“Main”中的示例在工作簿同一路径的一个文本文件中，我把这个postData信息这样放

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

并将标头设置为Content-Type，值设置为[{"key":"Content-Type","value":"application/x-www-form-urlencoded","description":"","type":"text","enabled":true}] 在邮递员身上尝试时，我得到了这样的回应

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

这是我期望的响应.. 但是在将其应用于代码时，它不起作用，我在应该提取我需要的信息的最后部分出错

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

我试图通过类似的代码获取 VIEWSTATE 但同样的问题

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

【问题讨论】：

很挑剔但缩进有点偏离（Q&A），也可以在一些代码行之间使用更多的空白，以便于阅读。也避免自动实例化。函数签名应该是 ByVal。 Environ 可以是 Environ$

标签： excel vba web-scraping xmlhttprequest

【解决方案1】：

我可以通过这种方式来解决.. 但是如果有办法提高代码的速度，我将不胜感激。由于代码考虑打开 URL 两次而不是一次

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

【讨论】：

不要循环读取工作表。将值存储在数组中并循环。其余的，您主要受互联网连接和服务器的支配。另外，使用更好的变量名。
非常感谢我的导师。您是否测试过代码..？通过将循环移动到 postData 行之前开始，我使它更快一点。这意味着我得到了一次 VIEWSTATE 来完成任务。但我不确定在这么多点击后是否会失败。
VIEWSTATE 可以随着时间的推移在不同的请求之间发生变化。值得一试。