'-----------------------------------------------------------------------------
' 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)