Excel VBA XML HTTP-代码不适用于Windows 8

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

该功能在Windows 7上运行良好，但不幸的是在Windows 8上无法运行。有人能帮我写在Windows7和Windows8上都能用的代码吗？我想我需要使用不同版本的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

函数GetHtmlDoc（ByVal URL作为字符串）作为对象 作为字符串的Dim msg '重置全局变量。 PageSrc=“” 设置htmlDoc=Nothing 使用CreateObject（“MSXML2.XMLHTTP”） .打开“获取”，URL，True .发送 While.readyState 4:DoEvents:Wend a=.statusText '检查是否存在任何服务器错误。 如果.statusText为“OK”，则 '检查WinHTTP错误。 'msg=GetWinHttpErrorMsg（.Status） '如果msg=”“，则msg=.statusText '返回错误号和消息。 GetPageSource=“错误：&.Status&-”&msg 退出功能 如果结束 '将HTML代码保存在全局变量中。 PageSrc=.responseText 以 '创建一个空的HTML文档。 设置htmlDoc=CreateObject（“htmlfile”） htmlDoc.openURL:=“text/html”，Replace:=False '将HTML代码转换为HTML文档对象。 htmlDoc.write PageSrc '使用全局变量终止输入输出。 htmlDoc.关闭 '返回网页的HTML文本。 设置GetHtmlDoc=htmlDoc 端函数 函数调用示例：

设置htmlDoc= GetHtmlDoc（“”）

---

XMLHTTP

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

ServerXMLHTTP

：

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

---

（使用

False

同步执行操作，以满足

readyState

循环的需要。）

您好，谢谢您的回答。但它在Windows8上给出了一条错误消息。这是截图。你能看一下吗？