VBa post 来自 Curl 的请求
VBa post request from Curl
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
它给我一个错误,我在哪里做错了
你必须使用
设置 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
它现在的工作很棒
谢谢大家
' 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
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
它给我一个错误,我在哪里做错了
你必须使用
设置 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
它现在的工作很棒 谢谢大家
' 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