TechGeek
TechGeek

Reputation: 2212

Excel VBA XML HTTP - Code not working on Windows 8

I have the following function which returns HTML document for the URL passed. I am using the returned HTML Doc in some other function.

The function works perfectly on Windows 7 but NOT on windows 8 unfortunately. How can I write code which works on Windows 7 and 8 both? I think I need to use a different version of XML HTTP object.

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

Example function call:

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

Upvotes: 0

Views: 1500

Answers (1)

Alex K.
Alex K.

Reputation: 175826

XMLHTTP no longer likes accessing remote servers from local scripts, switch to ServerXMLHTTP:

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

(Using False performs the operation synchronously ngating the need for the readyState loop.)

Upvotes: 2

Related Questions