来自Curl的VBa发布请求

问题描述

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

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,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

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

解决方法

您必须使用
设置xmlhttp = CreateObject（“ Msxml2.ServerXMLHTTP.6.0”）
而不是'xmlhttp = CreateObject（“ Microsoft.xmlhttp”）
先决条件：在项目的首选项中，只需添加Microsoft winHttp Services版本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

,

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

' 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",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",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