Microsoft.XMLHTTP抓取网页卡死，设置超时的方法

正常情况下，我们采用以下代码抓取网页，若是网页能访问，抓取都没问题。若是网站出现故障，那么往往会出现Excel卡死现象。

Public Function getHtmlStr(strUrl) '获取源码
    'www.exceloffice.net同步抓取
    Dim XmlHttp
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    XmlHttp.Open "GET", strUrl, False
    XmlHttp.send
    getHtmlStr = StrConv(XmlHttp.ResponseBody, vbUnicode)
    Set XmlHttp = Nothing
End Function

而Microsoft.XMLHTTP又不像Msxml2.ServerXMLHTTP具有SetTimeOuts方法，需要将上述函数更改如下。其中要注意把同步抓取改为异步抓取XmlHttp.Open “GET”, strUrl, True，否则就没有意义。

Public Function getHtmlStr(strUrl) '获取源码
    'www.exceloffice.net
    Dim XmlHttp
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    XmlHttp.Open "GET", strUrl, True
    XmlHttp.send
    stime = Now '获取当前时间
    While XmlHttp.ReadyState <> 4
        DoEvents
        ntime = Now '获取循环时间
        If DateDiff("s", stime, ntime) > 5 Then getHtmlStr = "": Exit Function '判断超出5秒即超时退出过程
    Wend
    getHtmlStr = StrConv(XmlHttp.ResponseBody, vbUnicode)
    Set XmlHttp = Nothing
End Function