时间戳

首页 > 解决方案 > 邮政数据在邮递员中工作，而不是在 VBA 中

excel - 邮政数据在邮递员中工作，而不是在 VBA 中

问题描述

我正在尝试根据搜索项获取一些数据。A2中的工作表“Main”中的示例284112500592..在工作簿相同路径的文本文件中，我将这个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

标签： excelvbaweb-scrapingxmlhttprequest

解决方案

我可以通过这种方式弄清楚..但是如果有一种方法可以提高代码的速度，我将不胜感激。由于代码考虑打开 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

推荐阅读