Excel VBA XML HTTP - 代码在 Windows 8 上不起作用

Question

我有以下函数，它返回传递的 URL 的 HTML 文档。我在其他函数中使用返回的 HTML Doc。

该功能在 Windows 7 上完美运行，但不幸的是在 Windows 8 上无法运行。如何编写适用于 Windows 7 和 8 的代码？我想我需要使用不同版本的 XML HTTP 对象。

Function GetHtmlDoc(ByVal URL As String) As Object
    
    Dim msg As String
    
      ' Reset the Global variables.
        PageSrc = ""
        Set htmlDoc = Nothing
        
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, True
            .Send
                                
            While .readyState <> 4: DoEvents: Wend
            a = .statusText
            
          ' Check for any server errors.
            If .statusText <> "OK" Then
              ' Check for WinHTTP error.
                'msg = GetWinHttpErrorMsg(.Status)
                'If msg = "" Then msg = .statusText
                
              ' Return the error number and message.
                GetPageSource = "ERROR: " & .Status & " - " & msg
                Exit Function
            End If
                            
          ' Save the HTML code in the Global variable.
            PageSrc = .responseText
        End With

      ' Create an empty HTML Document.
        Set htmlDoc = CreateObject("htmlfile")
        htmlDoc.Open URL:="text/html", Replace:=False
            
      ' Convert the HTML code into an HTML Document Object.
        htmlDoc.write PageSrc

      ' Terminate Input-Output with the Global variable.
        htmlDoc.Close

      ' Return the HTML text of the web page.
        Set GetHtmlDoc = htmlDoc
        
End Function

示例函数调用：

Set htmlDoc = GetHtmlDoc("http://www.censusdata.abs.gov.au/census_services/getproduct/census/2011/quickstat/POA2155?opendocument&navpos=220")

Answer 1

我有同样的错误，结果我的代码工作正常，只是防火墙阻止了 Excel，所以它失败了。

Answer 2

XMLHTTP不再喜欢从本地脚本访问远程服务器，切换到ServerXMLHTTP：

With CreateObject("MSXML2.ServerXMLHTTP")
    .Open "GET", URL, False

（使用False 同步执行操作，满足readyState 循环的需要。）