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

XMLHTTP不再喜歡從本地腳本訪問遠程服務器，請切換到ServerXMLHTTP ：

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

（使用False會同步執行操作，從而使需要readyState循環。）

Answer 2

我有同樣的錯誤，結果我的代碼工作正常，只是防火牆阻止了 Excel，所以它失敗了。