VBA Code to download Data into Excel Sheet from OData Feed From SharePoint PWA

[krishnaoptif]

May you please provide me VBA code to Download OData feed into excel sheet from SharePoint Project Web App. my web link is like myCompanyname.sharepoint.com/sites/wpa

Please see the details from where you can see the detailed info.

https://blogs.office.com/2012/10/31/server-reporting-in-pwa/

API link will be like : https://mycompanyname.sharepoint.com/sites/pwa/_api/ProjectData

but in above link there is no any option to provide data using VBA code directly.

 

[krishnaoptif]

Please consider this question becausei found some code from internet and used in below code:

I am unable to get data into excel file from OData Services (for SharePoint Project Web App) using below VBA code
Please see the details from where you can see the detailed info about OData.https://blogs.office.com/2012/10/31/server-reporting-in-pwa/
My Code which is not working:

Public Sub GetDataintoExcelFrom_SharePointProjectWebAppData_OData()
    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("name")
        rng(lngRow, 2) = objEntry("Address")
        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