【转载】VBA读取一个来自web服务器或网站文件的函数-金宇
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


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

发表时间:2014/4/29 9:25:45 评论(1) 浏览(6080)  评论 | 加入收藏 | 复制
   
摘 要: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)


Access软件网交流QQ群(群号:198465573)
 
 相关文章
打开某个网站的OnlineWeb函数;Access打开网页VBA代...  【竹笛  2006/3/4】
[示例]单击按钮打开网址链接;Access打开网站示例;Acces...  【钱玉炜  2008/9/2】
打开某个网址函数OnlineWeb  【竹笛  2008/12/8】
用命令按钮打开超链接网址的示例(可以任意定义盘符、文件名及网址)  【麥田  2012/3/17】
学习在窗体中加入web浏览器控件  【陈先生  2012/8/12】
常见问答
技术分类
相关资源
文章搜索
关于作者

金宇

文章分类

文章存档

友情链接