添加一个时钟控件，运行后就可以在立即窗口看到调试信息。

Option Explicit Function GetBody(Url) Dim ObjXML Set ObjXML = CreateObject("Microsoft.XMLHTTP") With ObjXML .Open "Get",Url,False,"","" .SEnd GetBody = .ResponseBody End With GetBody = BytesToBstr(GetBody,"UTF-8") Set ObjXML = Nothing End Function Function BytesToBstr(strBody,CodeBase) Dim ObjStream Set ObjStream = CreateObject("Adodb.Stream") With ObjStream .Type = 1 .Mode = 3 .Open .Write strBody .Position = 0 .Type = 2 .Charset = CodeBase BytesToBstr = .ReadText .Close End With Set ObjStream = Nothing End Function Private Sub Form_Load() Timer1.Interval = 1000 End Sub Private Sub Timer1_Timer() Dim strHTML As String strHTML = GetBody("http://www.cdcgames.net/GetTime/Default.aspx") Debug.Print strHTML End Sub

http://zhidao.baidu.com/question/40057444.html

http://zhidao.baidu.com/question/59283660.html

Option Explicit 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 Function GetWebCodesDL(WebUrl As String) As String On Error Resume Next If WebUrl = "" Then Exit Function Dim TempFile$ TempFile = App.Path & "/DownTemp.html" '下载<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a> URLDownloadToFile 0,WebUrl,TempFile,0 '读取<a href="https://www.jb51.cc/tag/neirong/" target="_blank" class="keywords">内容</a> If Dir(TempFile) <> "" Then Open TempFile For Input As #1 Input #1,GetWebCodesDL Close #1 Kill TempFile End If End Function Function GetWebCodes(WebUrl As String) As String On Error Resume Next If WebUrl = "" Then Exit Function Dim xmlHTTP1 Set xmlHTTP1 = CreateObject("Microsoft.XMLHTTP") xmlHTTP1.Open "get",True xmlHTTP1.SEnd While xmlHTTP1.ReadyState <> 4 DoEvents Wend GetWebCodes = xmlHTTP1.responseText Set xmlHTTP1 = Nothing End Function Function GetHtmlCodes(ByRef WebBrowser As WebBrowser,ByRef WebUrl As String) As String On Error Resume Next If WebUrl = "" Then Exit Function WebBrowser.Navigate WebUrl While WebBrowser.ReadyState <> 4 DoEvents Wend GetHtmlCodes = WebBrowser.Document.documentElement.Outertext End Function 'Function GetHtmlCodes(WebBrowser As WebBrowser,WebUrl As String) As String ' If WebUrl = "" Then Exit Function ' Dim web1 ' Set web1 = Form1.Controls.Add("SHELL.EXPLORER.2","web1") ' web1.Visible = True ' web1.Move 0,15,15 ' web1.Navigate WebUrl ' While web1.ReadyState <> 4 ' DoEvents ' Wend ' GetHtmlCodes = web1.Document.documentElement.Outertext ' Set web1 = Nothing 'End Function ''Me.Controls.Add("SHELL.EXPLORER.2","web1",Me) Function GetBodyCodes(Url) On Error Resume Next Url = Url & "?rNum=" & Int((9999) * Rnd(Now()) + 1) Dim ObjXML Set ObjXML = CreateObject("Microsoft.XMLHTTP") With ObjXML .Open "Get","" .SEnd GetBodyCodes = .ResponseBody End With GetBodyCodes = BytesToBstr(GetBodyCodes,"UTF-8") Set ObjXML = Nothing End Function Function BytesToBstr(strBody,CodeBase) Dim ObjStream Set ObjStream = CreateObject("Adodb.Stream") With ObjStream .Type = 1 .Mode = 3 .Open .Write strBody .Position = 0 .Type = 2 .Charset = CodeBase BytesToBstr = .ReadText .Close End With Set ObjStream = Nothing End Function Function GetBodyCodes2(Url) On Error Resume Next Url = Url & "&rNum=" & Int((9999) * Rnd(Now()) + 1) '''&&&&???? Dim ObjXML Set ObjXML = CreateObject("Microsoft.XMLHTTP") With ObjXML .Open "Get","" .SEnd GetBodyCodes2 = .ResponseBody End With GetBodyCodes2 = BytesToBstr(GetBodyCodes2,"gb2312") Set ObjXML = Nothing End Function