2

Excel VBAを介してWebサイトのソースコードを受信しようとすると、約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
4

3 に答える 3

0

要求に応じて、完全なソースコードを取得する別の方法：

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
于 2012-07-17T12:04:44.710 に答える
0

問題はラインです

Cells(2, 2) = sTotalData

sTotalDataセルに文字列を返すことは、それより長くても、Excel2007/2010では32767文字に制限されます。

このリンクを参照してください

于 2012-07-11T09:48:27.967 に答える
0

やってみました ：

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
于 2014-09-25T11:16:02.923 に答える