除了你提到的方法之外:
- IE 自动化
- WinHTTPRequest
- XMLHTTP
- ServerXMLHTTP
您可以考虑其他 2 种方法:
- 使用
MSHTML.HTMLDocument对象的CreateDocumentFromUrl方法
- 使用 Windows API 函数
URLDownloadToFileA
我忽略了其他一些 Windows API,例如 InternetOpen、InternetOpenUrl 等,因为猜测响应长度、缓冲响应等的复杂性会超过潜在的性能。
CreateDocumentFromUrl
使用CreateDocumentFromUrl 方法时,您的示例网站会出现问题,因为它会尝试在不允许出现以下错误的框架中创建HTMLDocument:
禁止装帧
和
为帮助保护您输入本网站的信息的安全性,此内容的发布者不允许将其显示在框架中。
所以我们不应该使用这种方法。
URLDownloadToFileA
我认为您需要 php 等效于 file_get_contents 并找到了这个方法。它很容易使用(检查this link),并且在用于大请求时优于其他方法(例如,当您使用 >2000 个棒球棒时尝试它)。 XMLHTTP 也使用了 URLMon 库,所以我想这种方式只是减少了一些中间人逻辑,显然有一个缺点,因为你必须做一些文件系统处理。
Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Sub TestUrlDownloadFile(strUrl As String)
Dim dteStart As Date
Dim dteFinish As Date
Dim strTempFileName As String
Dim strResponse As String
Dim objFso As FileSystemObject
On Error GoTo ExitFunction
dteStart = Now
strTempFileName = "D:\foo.txt"
DownloadFile strUrl, strTempFileName
Set objFso = New FileSystemObject
With objFso.OpenTextFile(strTempFileName, ForReading)
strResponse = .ReadAll
.Close
End With
objFso.DeleteFile strTempFileName
dteFinish = Now
Debug.Print "URL download file method"
Debug.Print "Document length: " & Len(strResponse) & " chars"
Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
Debug.Print VBA.vbNewLine
ExitFunction:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
End Sub
'http://www.vbaexpress.com/forum/archive/index.php/t-27050.html
Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
使用 URLDownloadToFileA 下载示例 URL 大约需要 1-2 秒,而使用 XMLHTTP 方法需要 4-5 秒(完整代码如下)。
网址:
www.justbats.com/products/bat type~baseball/?sortBy=TotalSales Descending&page=1&size=2400
这是输出:
Testing...
XML HTTP method
Document length: 7869753 chars
Processed in: 4 seconds
URL download file method
Document length: 7869753 chars
Processed in: 1 seconds
代码
这包括所有讨论的方法,例如IE自动化、WinHTTPRequest、XMLHTTP、ServerXMLHTTP、CreateDocumentFromURL和URLDownloadFile。
您需要项目中的所有这些引用:
这里是:
Option Explicit
Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Sub Test()
Dim strUrl As String
strUrl = "http://www.justbats.com/products/bat type~baseball/?sortBy=TotalSales Descending&page=1&size=2400"
Debug.Print "Testing..."
Debug.Print VBA.vbNewLine
'TestIE strUrl
'TestWinHHTP strUrl
TestXMLHTTP strUrl
'TestServerXMLHTTP strUrl
'TestCreateDocumentFromUrl strUrl
TestUrlDownloadFile strUrl
End Sub
Sub TestIE(strUrl As String)
Dim dteStart As Date
Dim dteFinish As Date
Dim objIe As InternetExplorer
Dim objHtml As MSHTML.HTMLDocument
Dim strResponse As String
On Error GoTo ExitFunction
dteStart = Now
Set objIe = New SHDocVw.InternetExplorer
With objIe
.navigate strUrl
.Visible = False
While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set objHtml = .document
strResponse = objHtml.DocumentElement.outerHTML
.Quit
End With
dteFinish = Now
Debug.Print "IE automation method"
Debug.Print "Document length: " & Len(strResponse) & " chars"
Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
Debug.Print VBA.vbNewLine
ExitFunction:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
If Not objIe Is Nothing Then
objIe.Quit
End If
Set objIe = Nothing
End Sub
Sub TestWinHHTP(strUrl As String)
Dim dteStart As Date
Dim dteFinish As Date
Dim objHttp As WinHttp.WinHttpRequest
Dim objDoc As HTMLDocument
Dim strResponse As String
On Error GoTo ExitFunction
dteStart = Now
Set objHttp = New WinHttp.WinHttpRequest
With objHttp
.Open "get", strUrl, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
.WaitForResponse
strResponse = .responseText
End With
dteFinish = Now
Debug.Print "WinHTTP method"
Debug.Print "Document length: " & Len(strResponse) & " chars"
Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
Debug.Print VBA.vbNewLine
ExitFunction:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
Set objDoc = Nothing
Set objHttp = Nothing
End Sub
Sub TestXMLHTTP(strUrl As String)
Dim dteStart As Date
Dim dteFinish As Date
Dim objXhr As MSXML2.XMLHTTP60
Dim objDoc As MSHTML.HTMLDocument
Dim strResponse As String
On Error GoTo ExitFunction
dteStart = Now
Set objXhr = New MSXML2.XMLHTTP60
With objXhr
.Open "get", strUrl, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
While .readyState <> 4
DoEvents
Wend
strResponse = .responseText
End With
dteFinish = Now
Debug.Print "XML HTTP method"
Debug.Print "Document length: " & Len(strResponse) & " chars"
Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
Debug.Print VBA.vbNewLine
ExitFunction:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
Set objDoc = Nothing
Set objXhr = Nothing
End Sub
Sub TestServerXMLHTTP(strUrl As String)
Dim dteStart As Date
Dim dteFinish As Date
Dim objXhr As MSXML2.ServerXMLHTTP60
Dim objDoc As MSHTML.HTMLDocument
Dim strResponse As String
On Error GoTo ExitFunction
dteStart = Now
Set objXhr = New MSXML2.ServerXMLHTTP60
With objXhr
.Open "get", strUrl, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
While .readyState <> 4
DoEvents
Wend
strResponse = .responseText
End With
dteFinish = Now
Debug.Print "Server XML HTTP method"
Debug.Print "Document length: " & Len(strResponse) & " chars"
Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
Debug.Print VBA.vbNewLine
ExitFunction:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
Set objDoc = Nothing
Set objXhr = Nothing
End Sub
Sub TestUrlDownloadFile(strUrl As String)
Dim dteStart As Date
Dim dteFinish As Date
Dim strTempFileName As String
Dim strResponse As String
Dim objFso As FileSystemObject
On Error GoTo ExitFunction
dteStart = Now
strTempFileName = "D:\foo.txt"
If DownloadFile(strUrl, strTempFileName) Then
Set objFso = New FileSystemObject
With objFso.OpenTextFile(strTempFileName, ForReading)
strResponse = .ReadAll
.Close
End With
objFso.DeleteFile strTempFileName
Else
Debug.Print "Error downloading file from URL: " & strUrl
GoTo ExitFunction
End If
dteFinish = Now
Debug.Print "URL download file method"
Debug.Print "Document length: " & Len(strResponse) & " chars"
Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
Debug.Print VBA.vbNewLine
ExitFunction:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
End Sub
'http://www.vbaexpress.com/forum/archive/index.php/t-27050.html
Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then
DownloadFile = True
Else
DownloadFile = False
End If
End Function
Sub TestCreateDocumentFromUrl(strUrl As String)
Dim dteStart As Date
Dim dteFinish As Date
Dim strResponse As String
Dim objDoc1 As HTMLDocument
Dim objDoc2 As HTMLDocument
On Error GoTo ExitFunction
dteStart = Now
Set objDoc1 = New HTMLDocument
Set objDoc2 = objDoc1.createDocumentFromUrl(strUrl, "null")
While objDoc2.readyState <> "complete"
DoEvents
Wend
strResponse = objDoc2.DocumentElement.outerHTML
Debug.Print strResponse
dteFinish = Now
Debug.Print "HTML Document Create from URL method"
Debug.Print "Document length: " & Len(strResponse) & " chars"
Debug.Print "Processed in: " & Format(dteFinish - dteStart, "s") & " seconds"
Debug.Print VBA.vbNewLine
ExitFunction:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
Set objDoc2 = Nothing
Set objDoc1 = Nothing
End Sub