【转载】VBA读取一个来自web服务器或网站文件的函数

时　间:2014-04-29 09:25:45
作　者:Daniel Pineault   ID：43  城市：江阴
摘　要:VBA读取一个来自web服务器或网站的文件的函数
正　文:

'-----------------------------------------------------------------------------
' Procedure : ReadURLFile
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Access and read a file on a webserver
' Copyright : The following may be altered and reused as you wish so long as the
'        copyright notice is left unchanged (including Author, Website and
'        Copyright). It may not be sold/resold or reposted on other sites (links
'        back to this site are allowed). '
' Input Variables: ' ~~~~~~~~~~~~~~~~
' sFullURLWFile : Full URL and Filename with the extension '
' Usage: ' ~~~~~~
' ReadURLFile("http://www.google.ca/index.html")
' ReadURLFile("http://www.SomeDomain.com/SomeFolder/SomeFIle.txt")
' Revision History: ' Rev Date(yyyy/mm/dd) Description
' 1 2012-Jul-07 Initial Release '-------------------------
'-------------------------------------------------------------
Function ReadURLFile(sFullURLWFile As String) As String
On Error GoTo Error_Handler
Dim oHttp As Object
Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
Call oHttp.Open("GET", sFullURLWFile, False)
Call oHttp.Send 'Check for any errors reported by the server
If oHttp.Status >= 400 And oHttp.Status <= 599 Then
    ReadURLFile = ""
    GoTo Error_Handler
Else
    ReadURLFile = oHttp.ResponseText
End If
Error_Handler_Exit:
    On Error Resume Next
    Call oHttp.Close
    Set oHttp = Nothing
    Exit Function
Error_Handler:
    If oHttp.Status >= 400 And oHttp.Status <= 599 Then
        MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
                "Error Number: " & oHttp.Status & vbCrLf & _
                "Error Source: ReadURLFile" & vbCrLf & _
                "Error Description: " & oHttp.StatusText, _
                vbCritical, "An Error has Occured!"
    Else
        MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
        "Error Number: " & Err.Number & vbCrLf & _
        "Error Source: ReadURLFile" & vbCrLf & _
        "Error Description: " & Err.Description, _
        vbCritical, "An Error has Occured!"
    End If
Resume Error_Handler_Exit
End Function

使用示例：
Debug.Print ReadURLFile(http://news.sina.com.cn/c/2014-04-28/234930027701.shtml)