1

vba我对这段代码有一些问题。这项工作从一年多开始。上次执行后，".Write objHTTP.responseBody --runtime error 3001"我尝试找出解决方案时出错，但我没有任何想法。代码在页面上登录并下载4个文件。

这是 POST 信息：

Answers headers (250 B) 
Connection  
Keep-Alive
Content-Disposition 
attachement; filename="baza.csv";
Content-Type    
application/csv
Date    
Tue, 17 Jul 2018 13:58:32 GMT
Keep-Alive  
timeout=5, max=300
Server  
Apache/2.4.25
Transfer-Encoding   
chunked
Request Headers (976 B) 
Accept  
text/html,application/xhtml+xm…plication/xml;q=0.9,*/*;q=0.8
Accept-Encoding 
gzip, deflate, br
Accept-Language 
pl,en-US;q=0.7,en;q=0.3
Connection  
keep-alive
Content-Length  38
Content-Type    
application/x-www-form-urlencoded
Cookie  _pk_id.50.777d=00d79034e23a5b6…41fc349c56e551787285709412976
DNT  1
Host    listarobinsonow.pl
Referer https://listarobinsonow.pl/userpanel/base
Upgrade-Insecure-Requests    1
User-Agent Mozilla/5.0 (Windows NT 10.0; …) Gecko/20100101 Firefox/61.0

代码：

Sub SMB_DownloadAll()

Dim destfolder As String
destfolder = ActiveWorkbook.Path

    ' Autoryzacja
    ' Dim objHTTP As New WinHttp.WinHttpRequest
    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

    URL = "http://www.listarobinsonow.pl/auth/login"
    objHTTP.Open "POST", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    objHTTP.send ("identity=xxxxxx&password=xxxxxxx")
    objHTTP.WaitForResponse

    ' pobranie 4 plików
    SMB_Download objHTTP, "post", destfolder
    SMB_Download objHTTP, "mail", destfolder
    SMB_Download objHTTP, "tele", destfolder
    SMB_Download objHTTP, "smss", destfolder

    ThisWorkbook.Save
End Sub

Sub SMB_Download(ByRef objHTTP, base_type As String, destfolder As String)

    URL = "http://www.listarobinsonow.pl/userpanel/base"
    objHTTP.Open "POST", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    objHTTP.send ("base_type=" + base_type + "&form_type=base_download")
    objHTTP.WaitForResponse

    ' Dim oStream1 As New ADODB.Stream
    Set oStream1 = CreateObject("ADODB.Stream")
    With oStream1
        .Type = 1
        .Open
        .Write objHTTP.responseBody - the place where i get error run time 3001 
        .SaveToFile destfolder + "\" + base_type + ".csv", 2
    End With 
End Sub
4

0 回答 0