So erstellen Sie komplexe POST mit VBA

Question

Ich habe ein Problem mit POST HTTPrequest in VBA. Ich habe Fiddler Log mit einigen Parametern und JSON Zeug. Parameter sind zwei, JSON (ist dieser Parameter auch?) Ist eins. Es sieht wie folgt aus:

Und hier ist meine Frage - wie diese Parameter alle zusammen zu schicken? Wäre ideal in VBA, aber auch allgemeine Antwort wäre toll.

Ich möchte sagen, ich bin ein bisschen neu in diesem Zeug.

Grüße, Luke.

Answer 1

Versuchen richtige Plätzchen und Content-Type-Header in einer Anfrage, werfen Sie einen Blick auf das folgende Beispiel zur Verfügung zu stellen, verwendet es MSXML2.ServerXMLHTTP mit Cookies zu verwalten:

Option Explicit 

Sub scrape_kody_poczta_polska_pl() 

    Dim sRespHeaders As String 
    Dim aSetHeaders 
    Dim sPayload As String 
    Dim sRespText As String 
    Dim aRows 
    Dim aCells 
    Dim i As Long 
    Dim j As Long 
    Dim aData 

    ' Get search page to retrieve cookies 
    XmlHttpRequest _ 
     "GET", _ 
     "http://kody.poczta-polska.pl/", _ 
     Array(), _ 
     "", _ 
     sRespHeaders, _ 
     "" 
    ' Extract cookies 
    ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders 
    ' Setup request 
    sPayload = "kod=20-610&page=kod" 
    PushItem aSetHeaders, Array("Content-Type", "application/x-www-form-urlencoded") 
    ' Retrieve results 
    XmlHttpRequest _ 
     "POST", _ 
     "http://kody.poczta-polska.pl/index.php", _ 
     aSetHeaders, _ 
     sPayload, _ 
     "", _ 
     sRespText 
    ' Parse table rows 
    ParseResponse _ 
     "(<tr>(?:[\s\S]*?<t[dh]>[\s\S]*?</t[dh]>)+?[\s\S]*?</tr>)", _ 
     sRespText, _ 
     aRows 
    ' Parse table cells 
    For i = 0 To UBound(aRows) 
     ParseResponse _ 
      "<t[dh]>([\s\S]*?)</t[dh]>", _ 
      aRows(i), _ 
      aCells, _ 
      False 
     For j = 0 To UBound(aCells) 
      aCells(j) = DecodeHTMLEntities((aCells(j))) 
     Next 
     aRows(i) = aCells 
    Next 
    ' Output 
    With ThisWorkbook.Sheets(1) 
     .Cells.Delete 
     .Cells.HorizontalAlignment = xlCenter 
     .Cells.VerticalAlignment = xlTop 
     aData = Denestify(aRows) 
     If IsArray(aData) Then Output2DArray .Cells(1, 1), aData 
    End With 

End Sub 

Sub XmlHttpRequest(sMethod, sUrl, aSetHeaders, sPayload, sRespHeaders, sRespText) 

    Dim aHeader 

    With CreateObject("MSXML2.ServerXMLHTTP") 
     .SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS 
     .Open sMethod, sUrl, False 
     For Each aHeader In aSetHeaders 
      .SetRequestHeader aHeader(0), aHeader(1) 
     Next 
     .Send sPayload 
     sRespHeaders = .GetAllResponseHeaders 
     sRespText = .ResponseText 
    End With 

End Sub 

Sub ParseResponse(sPattern, sResponse, aData, Optional bAppend As Boolean = True) 

    Dim oMatch 
    Dim aTmp() 
    Dim sSubMatch 

    If Not (IsArray(aData) And bAppend) Then aData = Array() 
    With CreateObject("VBScript.RegExp") 
     .Global = True 
     .MultiLine = True 
     .Pattern = sPattern 
     For Each oMatch In .Execute(sResponse) 
      If oMatch.SubMatches.Count = 1 Then 
       PushItem aData, oMatch.SubMatches(0) 
      Else 
       aTmp = Array() 
       For Each sSubMatch In oMatch.SubMatches 
        PushItem aTmp, sSubMatch 
       Next 
       PushItem aData, aTmp 
      End If 
     Next 
    End With 

End Sub 

Sub PushItem(aData, vItem, Optional bAppend As Boolean = True) 

    If Not (IsArray(aData) And bAppend) Then aData = Array() 
    ReDim Preserve aData(UBound(aData) + 1) 
    aData(UBound(aData)) = vItem 

End Sub 

Function DecodeHTMLEntities(sText As String) As String 

    Static oHtmlfile As Object 
    Static oDiv As Object 

    If oHtmlfile Is Nothing Then 
     Set oHtmlfile = CreateObject("htmlfile") 
     oHtmlfile.Open 
     Set oDiv = oHtmlfile.createElement("div") 
    End If 
    oDiv.innerHTML = sText 
    DecodeHTMLEntities = oDiv.innerText 

End Function 

Function Denestify(aRows) 

    Dim aData() 
    Dim aItems() 
    Dim i As Long 
    Dim j As Long 

    If UBound(aRows) = -1 Then Exit Function 
    ReDim aData(1 To UBound(aRows) + 1, 1 To 1) 
    For j = 0 To UBound(aRows) 
     aItems = aRows(j) 
     For i = 0 To UBound(aItems) 
      If i + 1 > UBound(aData, 2) Then ReDim Preserve aData(1 To UBound(aRows) + 1, 1 To i + 1) 
      aData(j + 1, i + 1) = aItems(i) 
     Next 
    Next 
    Denestify = aData 

End Function 

Sub Output2DArray(oDstRng As Range, aCells As Variant) 

    With oDstRng 
     .Parent.Select 
     With .Resize(_ 
       UBound(aCells, 1) - LBound(aCells, 1) + 1, _ 
       UBound(aCells, 2) - LBound(aCells, 2) + 1) 
      .NumberFormat = "@" 
      .Value = aCells 
     End With 
    End With 

End Sub 

für mich Die Ausgabe wie folgt:

und das ist das gleiche wie die Ergebnisse auf der Webseite:

Ich füge unten einige Variablenwerte hinzu, es kann helfen, im Falle irgendwelcher Probleme zu debuggen. Um den Inhalt von sRespHeaders und sRespText zu sehen, habe ich zusätzlich procedure WriteTextFile from this answer verwendet.

sRespHeaders nach dem ersten XmlHttpRequest Anruf (execute WriteTextFile sRespHeaders, "C:\tmp.txt", -1):

Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0 
Date: Sat, 26 Aug 2017 14:24:48 GMT 
Pragma: no-cache 
Transfer-Encoding: chunked 
Content-Type: text/html; charset=UTF-8 
Expires: Thu, 19 Nov 1981 08:52:00 GMT 
Server: Apache 
Set-Cookie: PHPSESSID=rl4gc6nq91tfb34u2inj634u10; path=/ 
Set-Cookie: restrwww4=!hN5+tRTsssR9ii3Yf8b335uDNFxhmd5PNCjvCndeUeIwBxZnB38oHuGc9Nz19debb6vLbW1nYQ+Ncgw=; path=/; Httponly 
X-Cnection: close 

aSetHeaders nach dem Extrahieren Cookies:

relevanter Teil sRespText eine Tabelle mit Zieldaten nach dem zweiten XmlHttpRequest Anruf enthalten (Führen Sie WriteTextFile sRespText, "C:\tmp.htm", -1 aus):

<table border="0" width="100%"> 
<tr> 
    <th>lp.</th> 
    <th>kod PNA</th> 
    <th>nazwa <br />(firmy lub placówki pocztowej)</th> 
    <th>miejscowość</th> 
    <th>adres</th> 
    <th>województwo</th> 
    <th>powiat</th> 
    <th>gmina</th> 
</tr> 
      <tr> 
      <td>1.</td> 
      <td>20-610</td> 
    <td></td> 
      <td>Lublin</td> 
      <td>     Kajetana Hryniewieckiego        <br /> 
      <i>numery od&nbsp;1&nbsp;do&nbsp;końca&nbsp;obie strony</i> 
      </td> 
      <td>LUBELSKIE</td> 
      <td>Lublin</td> 
      <td>Lublin</td> 
     </tr> 
     <tr> 
      <td>2.</td> 
      <td>20-610</td> 
    <td></td> 
      <td>Lublin</td> 
      <td>     Leszka Czarnego        <br /> 
      <i>numery od&nbsp;1&nbsp;do&nbsp;końca&nbsp;obie strony</i> 
      </td> 
      <td>LUBELSKIE</td> 
      <td>Lublin</td> 
      <td>Lublin</td> 
     </tr> 
     <tr> 
      <td>3.</td> 
      <td>20-610</td> 
    <td></td> 
      <td>Lublin</td> 
      <td>     Mieszka I        <br /> 
      <i>numery od&nbsp;1&nbsp;do&nbsp;końca&nbsp;obie strony</i> 
      </td> 
      <td>LUBELSKIE</td> 
      <td>Lublin</td> 
      <td>Lublin</td> 
     </tr> 
     <tr> 
      <td>4.</td> 
      <td>20-610</td> 
    <td></td> 
      <td>Lublin</td> 
      <td>     Piastowska        <br /> 
      <i>numery od&nbsp;1&nbsp;do&nbsp;końca&nbsp;obie strony</i> 
      </td> 
      <td>LUBELSKIE</td> 
      <td>Lublin</td> 
      <td>Lublin</td> 
     </tr> 
</table> 

aRows nach Tabellenzeilen-Analyse:

aRows nach Tabellenzellen-Analyse:

aData nach Denestify Aufruf: