VBa post 来自 Curl 的请求

Question

id 在将 Curl 转换为 VBa 代码时遇到问题，我尝试过的响应都是错误的，但是使用 postman 程序我可以访问数据卷曲代码是

curl 'http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/AcenteBilgi' \ -H 'Connection: keep-alive' \ -H 'Accept: */*' \ -H 'X-Requested-With: XMLHttpRequest' \ -H 'User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.121 Safari/537.36' \ -H 'Content-Type: application/x-www-form-urlencoded; charset=UTF-8' \ -H 'Origin: http://yatirimisletmeleruygulama.kultur.gov.tr' \ -H 'Referer: http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu' \ -H 'Accept-Language: en-US,en;q=0.9,ar;q=0.8' \ -H 'Cookie: __RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1' \ --data-raw 'id=49443&subeid=&__RequestVerificationToken=SOzWMSK-8Snd2SZHALdkktbhKu4tFCp_6arR2mrXwRqsovx2eHxMI0hARoyS0Hw14c0FgJUX5DumXoiNTobgDIhs8vyMSz8sLEq6ZNz7Nyc1' \ --compressed \ --insecure

当我尝试像这样在 VBA 中编写它时 :

Sub test17() Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String 'xmlhttp = CreateObject("MSXML2.ServerXMLHTTP") myurl = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/AcenteBilgi" 'myurl = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu" xmlhttp.Open "POST", myurl, False xmlhttp.setRequestHeader "Connection", "keep-alive" xmlhttp.setRequestHeader "Accept", "*/*" xmlhttp.setRequestHeader "X-Requested-With", "XMLHTTP60Request" '"XMLHttpRequest" xmlhttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.102 Safari/537.36" xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8" xmlhttp.setRequestHeader "Origin", "http://yatirimisletmeleruygulama.kultur.gov.tr" xmlhttp.setRequestHeader "Referer", "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu" xmlhttp.setRequestHeader "Accept-Language", "en-US,en;q=0.9,ar;q=0.8" xmlhttp.setRequestHeader "Cookie", "__RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1" xmlhttp.setRequestHeader "data-raw", "id=49443&subeid=&__RequestVerificationToken=gTnyeUJ6DQClZR2x5O31jxReR8hnWiCCnYyEFVYc2C_vXGTwBmHsYYTgN0PrY33giufZJttvmQihd3HZnueSa-Eldu63rN6RBA7spkulbiQ1" RQS = [{"id":"49443","subeid":"","__RequestVerificationToken":"7Q6YVOIyyjyX4K6OvdGdSBpgfOjmS6mm28niZKHp8W0GQX32G8h31nIXj17noMbkSqzxkOOuM7kqpCyqBVkC44GGg-g10109QImOjE6BY801"}] xmlhttp.send RQS 'xmlhttp.send RQS '("id=49443&subeid=&__RequestVerificationToken=gTnyeUJ6DQClZR2x5O31jxReR8hnWiCCnYyEFVYc2C_vXGTwBmHsYYTgN0PrY33giufZJttvmQihd3HZnueSa-Eldu63rN6RBA7spkulbiQ1") 'MsgBox xmlhttp.responseText Debug.Print xmlhttp.responseText Debug.Print xmlhttp.getAllResponseHeaders End Sub

它给我一个错误，我在哪里做错了

Answer 1

你必须使用
设置 xmlhttp = CreateObject("Msxml2.ServerXMLHTTP.6.0")
而不是 'xmlhttp = CreateObject("Microsoft.xmlhttp")
先决条件：在项目的首选项中，只需添加 Microsoft winHttp Services, version 5.1

    Dim xmlhttp As New MSXML2.XMLHTTP60
    Dim myurl As String
    
    Set xmlhttp = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    
    myurl = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu"
    xmlhttp.Open "POST", myurl, False
    
    xmlhttp.setRequestHeader "Connection", "keep-alive"
    xmlhttp.setRequestHeader "Accept", "*/*"
    xmlhttp.setRequestHeader "X-Requested-With", "XMLHTTP60Request"
    xmlhttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.102 Safari/537.36"
    xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    xmlhttp.setRequestHeader "Origin", "http://yatirimisletmeleruygulama.kultur.gov.tr"
    xmlhttp.setRequestHeader "Referer", "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu"
    xmlhttp.setRequestHeader "Accept-Language", "en-US,en;q=0.9,ar;q=0.8"
    xmlhttp.setRequestHeader "Cookie", "__RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1"
    xmlhttp.setRequestHeader "data-raw", "id=49443&subeid=&__RequestVerificationToken=gTnyeUJ6DQClZR2x5O31jxReR8hnWiCCnYyEFVYc2C_vXGTwBmHsYYTgN0PrY33giufZJttvmQihd3HZnueSa-Eldu63rN6RBA7spkulbiQ1"
    
    RQS = [{"id":"49443","subeid":"","__RequestVerificationToken":"7Q6YVOIyyjyX4K6OvdGdSBpgfOjmS6mm28niZKHp8W0GQX32G8h31nIXj17noMbkSqzxkOOuM7kqpCyqBVkC44GGg-g10109QImOjE6BY801"}]
    xmlhttp.send RQS
    
    MsgBox xmlhttp.responseText
    
    
    Debug.Print xmlhttp.responseText
    
    Debug.Print xmlhttp.getAllResponseHeaders

Answer 2

它现在的工作很棒谢谢大家

' bu makro ile siteden post ile veri alýnýr
Dim url As String
Dim data As String
On Error GoTo 10
url = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/AcenteBilgi"
Dim xhr As New ServerXMLHTTP60
'Dim xhr As Object
'Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
x = 4370 '
y = 4371
Do Until x = Sheet1.Range("b65000").End(3).Row
xhr.Open "POST", url

xhr.setRequestHeader "Connection", "keep-alive"
xhr.setRequestHeader "Accept", "*/*"
xhr.setRequestHeader "X-Requested-With", "XMLHttpRequest"
xhr.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.121 Safari/537.36"
xhr.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
xhr.setRequestHeader "Origin", "http://yatirimisletmeleruygulama.kultur.gov.tr"
xhr.setRequestHeader "Referer", "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu"
xhr.setRequestHeader "Accept-Language", "en-US,en;q=0.9,ar;q=0.8"
xhr.setRequestHeader "Cookie", "__RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1"
IDS = "id=" & Sheet1.Cells(x, 2)
If Sheet1.Cells(x, 3) = Empty Then
subIDs = "&subeid="
Else
subIDs = "&subeid=" & Sheet1.Cells(x, 3)
End If
Tokens = "__RequestVerificationToken=xG794QKU55Viyh-Hn13jgGyp10YyOj5Lph8uTbmKNVKA57Rq9GotGcv4JqmxtIVfvXoVu0P6wNhKAXY4cd2ckuw-8JmUd77_VTetXcl60VQ1"
'data = "id=" & Sheet1.Cells(x, 2) & "&subeid=&__RequestVerificationToken=xG794QKU55Viyh-Hn13jgGyp10YyOj5Lph8uTbmKNVKA57Rq9GotGcv4JqmxtIVfvXoVu0P6wNhKAXY4cd2ckuw-8JmUd77_VTetXcl60VQ1"

data = IDS & subIDs & "&" & Tokens
xhr.send data
'xhr.waitForResponse (10)
Do Until xhr.readyState = 4
DoEvents
Loop
 ' Debug.Print xhr.responseText 'xhr.responseText
Dim oDoc As HTMLDocument
  Set oDoc = New HTMLDocument
  oDoc.Body.innerHTML = xhr.responseText
  'Debug.Print oDoc.Body.innerText
  splits = Split(oDoc.Body.innerText, vbNewLine)
  Sheet1.Cells(x, 5) = Replace(Replace(splits(10), "E-posta", ""), " ", "")
  Sheet3.Range("a1:l1").Offset(Sheet3.Range("a65000").End(3).Row, 0).Cells = splits
  Set oDoc = Nothing
  Set xhr = Nothing
  x = x + 1
 If x = y Then
10
time1 = Now
time2 = Now + TimeValue("0:00:1")
    Do Until time1 >= time2
        DoEvents
        time1 = Now()
    Loop
 y = y + 70
 End If
 
  Loop

VBa post 来自 Curl 的请求

VBa post request from Curl

vba

curl

navbar

excel-2007

vba6