在SharePoint列表上获取请求

Question

我正在尝试使用VBA获取Sharepoint列表的元素，以在Excel工作表中显示和使用它们。

在MSXML2.ServerXMLHTTP60上的正常获取请求

Dim xmlObj as Object
Dim sUrl as String

sUrl = "http://<SarepointUrl>/_api/web/lists/GetByTitle('<listTitle>')/items"
Set xmlObj = NEw MSXML2.ServerXMLHTTP60

xmlObj.Open "GET", sUrl, False
xmlObj.setRequestHeader "Content-Type", "text/xml; charset=UTF-8"
xmlObj.send
Debug.Print xmlObj.responseText

响应异常：

System.UnauthorizedAccessException访问被拒绝。 您没有执行此操作的权限。

我尝试使用InternetExplorer对象访问xml，导航至请求的url：

.../getbytitle('listTitle')/items

但是Internet Explorer上的此页面被视为html页面。 我可以使用InternetExplorer.Document.body.outerText来获取其内容，并且所有xml都有一个字符串，但是我无法在真实的xml中解析它来提取数据。

Dim argUrl As String
Dim getUrl As String
Dim oHTMLDoc As HTMLDocument
Dim oXml As MSXML2.DOMDocument60
Dim objIE As New InternetExplorerMedium

argUrl = "https://<SharepointUrl>"

objIE.Visible = False
objIE.Silent = False
objIE.Navigate (argUrl)
objIE.Visible = False
Application.StatusBar = argUrl & " is loading. Please wait..."
Do While objIE.ReadyState = 4: DoEvents: Loop
Do Until objIE.ReadyState = 4: DoEvents: Loop

getUrl = "https://<SharepointUrl>/_api/web/lists/GetByTitle('ListTitle')/items"

objIE.Navigate (getUrl)
Application.StatusBar = getUrl & " is loading. Please wait..."
Do While objIE.ReadyState = 4: DoEvents: Loop
Do Until objIE.ReadyState = 4: DoEvents: Loop

Set oHTMLDoc = objIE.Document
Set oXml = New MSXML2.DOMDocument60

sXML = oHTMLDoc.body.outerText
Debug.Print sXML

'at this point it doesnt load the string as an XML because maybe this method (loadXML) needs an xml file instead of a string'
If oXml.LoadXML(sXML) Then
    Debug.Print "IF"
    Set nodeXML = xmlDoc
End If

任何人都能够解决所有这些问题，以便使用vba在共享点列表上进行get请求？

Answer 1

您可以尝试以下方法：

Sub GetItems()
    Const sUrl As String = "http://server/_api/Web/Lists/getByTitle('Parent')/items"
    Dim oRequest As WinHttp.WinHttpRequest
    Dim sResult As String
    'On Error GoTo Err_DoSomeJob

    Set oRequest = New WinHttp.WinHttpRequest
With oRequest
    .Open "GET", sUrl, True
    .setRequestHeader "Content-Type", "application/json"
    '.setRequestHeader "Accept", "application/json"
    .SetCredentials "domain\user", "pw", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
    .send
    .waitForResponse
    sResult = .responseText
    Debug.Print sResult
    sResult = oRequest.Status
    Debug.Print sResult
End With
End Sub