我有一个VBA代码,可以根据URL下载zip文件并将其保存到文件夹中。但是,下载的文件已损坏。使用VBA代码下载的文件的文件大小明显低于实际文件。 以下是我正在使用的代码:
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Sub DownloadFile
Dim L as long
L = URLDownloadToFile(0&, UrlFileName, DestinationFileName, 0&, 0&)
If L = 0 Then
Debug.Print "Download successful"
Else
Debug.Print "Download unsuccessful"
End If
End Sub
` 我正在下载ZIP文件的站点需要登录,我在运行所述VBA代码之前登录到该站点。
你能帮我解决这个问题吗?答案 0 :(得分:0)
确保引用MSXML,插入一个类模块,并在其中包含以下代码。只有在函数返回True的情况下才执行DownloadToFile,应该可以正常工作。
Public Function DoLoginByPost(URL As String, strUser As String, strPassword As String) As Boolean
Dim xHttp As MSXML2.XMLHTTP
Dim sTICKER As String
sTICKER = "user=" & strUser & "&pass=" & strPassword & "&logintype=login&pid=4&login=Login"
'Check this and edit accordingly by e.g. using the web developer tools in your browser when logging in regularly.
'You should be able to identify what form data is being sent when loggin on.
Set xHttp = New MSXML2.XMLHTTP
xHttp.Open "POST", URL
xHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xHttp.send sTICKER
Do Until xHttp.READYSTATE = 4
DoEvents
Loop
If xHttp.Status = 200 Then
DoLoginByPost = True
Else: DoLoginByPost = False
End If
End Function
'After receiving "TRUE", alter your original code to:
Set xHttp = New MSXML2.XMLHTTP
xHttp.Open "Get", UrlFileName, False
xHttp.send
Do Until xHttp.ReadyState = 4
DoEvents
Loop
Open DestinationFileName For Binary As #1
Put #1, , xHttp.responseBody
Close #1