Question

尝试通过Excel接收网站源代码VBA适用于大约4000个单词，40000个字符。然后停止。我不知道为什么。

任何人都可以帮助我吗？

Option Explicit
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Declare Function InternetOpen Lib "Wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetReadFile Lib "Wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "Wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "Wininet.dll" (ByVal hInet As Long) As Integer

Public Sub GetWebPageData()

  Dim hInternet, hSession, lngDataReturned As Long
  Dim iReadFileResult As Integer
  Dim sBuffer As String * 64
  Dim sTotalData As String
  Dim sUrl As String
  Dim sLine As String

  sUrl = "http://www.engadget.com/" 'Long Website here
  hSession = InternetOpen("", 0, vbNullString, vbNullString, 0)

  If hSession Then hInternet = InternetOpenUrl(hSession, sUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)

  If hInternet Then
    iReadFileResult = InternetReadFile(hInternet, sBuffer, 128, lngDataReturned)

    sTotalData = sBuffer

    Do While lngDataReturned <> 0
      iReadFileResult = InternetReadFile(hInternet, sBuffer, 128, lngDataReturned)
      sTotalData = sTotalData + Mid(sBuffer, 1, lngDataReturned)
    Loop
  End If

  iReadFileResult = InternetCloseHandle(hInternet)

  'WEBPAGE loaded into sTotalData
  Cells(2, 2) = sTotalData
End Sub

Answer 1

问题在于

行

Cells(2, 2) = sTotalData

在Excel 2007/2010中，将字符串返回到单元格的区别为32767个字符，即使sTotalData长于此值。

请参阅this link

Answer 2

根据要求，获取完整源代码的另一种方法是：

Function GetSource(url As String) As String

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url
    .Send
    Do: DoEvents: Loop Until .Readystate = 4
    GetSource = .responsetext
    .abort
End With

End Function

Answer 3

你试过了吗？

For i = 1 To Len(sTotalData) Step (Len(sTotalData) /  200) '*Line1 of 3 to replace Cells(2, 2) = sTotalData


Cells(i \ (Len(sTotalData) / 200) + 1, "A").Value = "'" & Mid(sTotalData, i, (Len(sTotalData) / 200)) '*Line2 of 3 to replace Cells(2, 2) = sTotalData


Next i '*Line3 of 3 to replace Cells(2, 2) = sTotalData

Excel VBA无法读取超过40,000个字符的Web源

3 个答案: