VBA代码，用于从SharePoint PWA的OData Feed将数据下载到Excel工作表中

Question

我无法使用以下VBA代码从OData Services（针对SharePoint Project Web App）将数据导入excel文件

请参阅详细信息，从中可以看到有关OData的详细信息。 https://blogs.office.com/2012/10/31/server-reporting-in-pwa/

我的代码无效：

Public Sub GetDataintoExcelFrom_SharePointProjectWebAppData_OData()
'Following : https://blogs.msdn.microsoft.com/marcelolr/2010/02/18/consuming-odata-with-office-vba-part-iii-excel/

Dim objDocument As MSXML2.DOMDocument60
Dim objEntries As Collection
Dim strUrl As String
'Read the document with data.
strUrl = "https://mycompanyname.sharepoint.com/sites/pwa/_api/ProjectData/[en-US]/Projects?$select=ProjectId,EnterpriseProjectTypeName,ParentProjectId,ProjectFinishDate,ProjectName,ProjectOwnerId,ProjectOwnerName,ProjectPercentCompleted,ProjectStartDate,ProjectEnterpriseFeatures"
Set objDocument = ODataReadUrl(strUrl)
'Create a collection of dictionaries with name/value pairs.
Set objEntries = ODataReadFeed(objDocument.DocumentElement)
'Prepare for updating and clear the document.
Application.ScreenUpdating = False
ActiveSheet.Cells.Clear
ActiveSheet.Cells.ClearFormats
'Build a table for all imported data.
Dim objEntry As Scripting.Dictionary
Dim lngRow As Long
Dim rng As Range
lngRow = 1
Set rng = Sheet1.Cells
rng(lngRow, 1) = "ProjectId" '"Bank Name"
rng(lngRow, 2) = "EnterpriseProjectTypeName" '"Address"
lngRow = lngRow + 1

For Each objEntry In objEntries
    rng(lngRow, 1) = objEntry("ProjectId")
    rng(lngRow, 2) = objEntry("EnterpriseProjectTypeName")
    lngRow = lngRow + 1
Next
Sheet1.Columns("A:B").AutoFit
'Make the headers bold
rng(1, 1).Font.Bold = True
rng(1, 2).Font.Bold = True
Application.ScreenUpdating = True
End Sub

'Given a URL, reads an OData feed or entry into an XML document.
Function ODataReadUrl(ByVal strUrl As String) As MSXML2.DOMDocument60
'Dim objXMLHTTP As MSXML2.XMLHTTP60
Dim objXMLHTTP As Object
Dim objResult As MSXML2.DOMDocument60
Dim strText As String
'Make a request for the URL.
'Set objXmlHttp = New MSXML2.XMLHTTP
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.Open "GET", strUrl, False
objXMLHTTP.send
If objXMLHTTP.Status <> 200 Then
    Err.Raise ODataCannotReadUrlError, "ODataReadUrl", "Unable to get " & strUrl & " – status code: " & objXMLHTTP.Status
End If
'Get the result as text.
strText = objXMLHTTP.responseText
Set objXMLHTTP = Nothing
'Create a document from the text.
Set objResult = New MSXML2.DOMDocument60
objResult.LoadXML strText
If objResult.parseError.ErrorCode <> 0 Then
    Err.Raise ODataParseError, "ODataReadUrl", "Unable to load " & strUrl & " – " & objResult.parseError.reason
End If
Set ODataReadUrl = objResult
End Function

'Given an OData feed document, reads the entries into a Collection.
Function ODataReadFeed(ByVal objFeed As MSXML2.IXMLDOMElement) As Collection
Dim objResult As Collection
Dim objChild As MSXML2.IXMLDOMNode
Set objResult = New Collection
Set objChild = objFeed.FirstChild
While Not objChild Is Nothing
    If objChild.NodeType = NODE_ELEMENT And _
        objChild.NamespaceURI = AtomNamespace And _
        objChild.BaseName = "entry" Then
        objResult.Add ODataReadEntry(objChild)
    End If
    Set objChild = objChild.NextSibling
Wend
Set ODataReadFeed = objResult
End Function