Understanding Access's automagic authentication to SharePoint Online

Question

I'm trying to automate SharePoint tasks from Microsoft Access using the REST API (since the CSOM is not available in VBA). This, however, requires me to authenticate.

I usually authenticate to SharePoint using Windows Authentication. I'm not required to enter a password to access OneDrive for Business or when opening files from SharePoint in Word.

The following code returns 403 Unauthorized and a System.UnauthorizedAccessException in the body of the response:

Dim xmlhttp As New MSXML2.XMLHTTP60
xmlhttp.Open "GET", "https://mycompany.sharepoint.com/mysite/_api/web", False
xmlhttp.setRequestHeader "Accept", "application/json;odata=verbose"
xmlhttp.send 'Executes a REST api request
Debug.Print xmlhttp.Status; xmlhttp.statusText 'Print status
Debug.Print xmlhttp.responseText 'Print the result

However, the following seems to work (returns 200 OK and the expected body):

DoCmd.TransferSharePointList acLinkSharePointList, https://mycompany.sharepoint.com/mysite, "UserInfo" 'Create a linked list, userinfo is present by default
DoCmd.DeleteObject acTable, "UserInfo" 'Delete the list you've just created
'From here, code is identical to what's shared above
Dim xmlhttp As New MSXML2.XMLHTTP60
xmlhttp.Open "GET", "https://mycompany.sharepoint.com/mysite/_api/web", False
xmlhttp.setRequestHeader "Accept", "application/json;odata=verbose"
xmlhttp.send 'Sends a REST api request
Debug.Print xmlhttp.Status; xmlhttp.statusText 'Print status
Debug.Print xmlhttp.responseText 'Print the result

Moreover, after creating and deleting a list, all my XMLHTTP requests seem to get authenticated automagically throughout the lifetime of the Access Application object (I don't need to create and delete the list over and over again). I'm not doing anything with request headers or cookies.

Can anyone explain to me why that is?

Is it documented somewhere?

Is there an alternate, better way to connect using VBA to modify files?

Answer 1

Can confirm this works. I spent a whole work day looking up RESTful scripting and had to setup a SharePoint app just to do what this does in 10 seconds. Unbelievable.

For anyone in the future, the 'hard' and probably more correct way to do this is a bit involved, but outlined below:

Go here in a browser https://-Your Tenant Name-.sharepoint.com/_layouts/15/appregnew.aspx

• generate a Client ID
• generate a Client secret copy them both into a text editor.
• Title = anything you want
• App Domain = google.com
• Redirect URL = https://localhost

Click Create

Once the app is created, go here in a browser

https://-Your Tenant Name-.sharepoint.com/_layouts/15/appinv.aspx

Lookup the app you made using the Client ID

copy and paste the following into Permission Request

<AppPermissionRequests AllowAppOnlyPolicy="true">
      <AppPermissionRequest Scope="http://sharepoint/content/sitecollection/web" Right="Read" /> 
 </AppPermissionRequests>

Click Create

You should now have an app that you can reference to generate a token for REST bearer authentication. To do that you must go to your app's settings and click on permission settings.

You will see a long string that looks like this: i:0i.t|ms.sp.ext| 620XXxxX-Xxxx-XxxX-XXXX-XXXxxXXxx694@633xxXXx-XXxx-xXXx-XxxX-xXXxXXxx88ee

The piece to the right of the @ symbol is your Tenant ID.

At this stage you should have 4 critical pieces: client id, client secret, tenant name, and tenant ID.

When you have those 4 pieces, you can run this VBA function to obtain a token:

Function GetSPtoken (TenantName, TenantID, ClientID, ClientSecret) As String
    Dim Req As Object
    Set Req = CreateObject("MSXML2.XMLHTTP")
  
  xURL = "https://accounts.accesscontrol.windows.net/" & TenantID & "/tokens/OAuth/2"
  Gnt = "client_credentials"
  Res = "00000003-0000-0ff1-ce00-000000000000/" & TenantName & ".sharepoint.com@" & TenantID
  CID = ClientID & "@" & TenantID
  CS = ClientSecret
  
  Req.Open "POST", xURL, False
  Req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

  body = ""
  body = body & "client_id=" & CID & "&"
  body = body & "client_secret=" & CS & "&"
  body = body & "resource=" & Res & "&"
  body = body & "grant_type=" & Gnt & "&"

  Req.send body
  response = Req.responseText

  token = right(response, instr(1, reponse, "access_token"), len(response)
  GetSPtoken = right(token, len(token)-2)

End Function

Token will by default be good for 24 hours. You can check the rest of the json response for details.