There can be instances in which you need to identify a user’s Microsoft Graph REST API ID, so their user id.
This can be useful at time for running certain HTTP requests for a specific user. Retrieve information, Create/Edit/Delete elements associated with their account (contacts, calendar events, e-mails, …)
The Current User’s Id
You can use a simply procedure such as the following one to retrieve the current user’s id.
'---------------------------------------------------------------------------------------
' Procedure : Microsoft_Users_GetId
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Get the current user's ID
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
' References:
'
' Usage:
' ~~~~~~
' ? Microsoft_Users_GetId
' Returns -> f3dc8a79-3533-3571-8efd-e400ds284fcf
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2024-05-27
'---------------------------------------------------------------------------------------
Public Function Microsoft_Users_GetId() As String
Dim sContentType As String
Dim sURL As String
Dim aHTTP_ResponseText() As String
Dim iCounter As Long
Dim Parsed As Dictionary
If OAuth2.access_token = "" Then OAuth2_StoredCredentials_Load 'Make sure we have credential before proceeding
If OAuth2_CheckToken = False Then DoCmd.OpenForm sAuthenticationForm, , , , , acDialog 'Force authentication if req'd
sContentType = "application/json"
sURL = "https://graph.microsoft.com/v1.0/me"
'Filters
'sURL = sURL & "?$select=id"
Call HTTP_SendRequest(sURL, "GET", sContentType, , True)
If lHTTP_Status = 200 Then
Set Parsed = JsonConverter.ParseJson(sHTTP_ResponseText)
Microsoft_Users_GetId = Parsed("id")
Set Parsed = Nothing
Else
Debug.Print lHTTP_Status
Debug.Print "--------"
Debug.Print sHTTP_ResponseText
End If
End Function
Retrieve Any User’s Id
If you are looking to retrieve another user’s Id, well, then you can do something like:
'---------------------------------------------------------------------------------------
' Procedure : Microsoft_Users_GetId
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Lookup a user based on search criteria and retrieve their user ID
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
' References:
'
' Usage:
' ~~~~~~
' ? Microsoft_Users_FindId(, "Daniel", "Pineault")
' Returns -> f3dc8a79-3533-3571-8efd-e400ds284fcf
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2024-05-27
'---------------------------------------------------------------------------------------
Public Function Microsoft_Users_FindId(Optional sId As String, _
Optional sGivenName As String, _
Optional sSurname As String, _
Optional sMobilePhone As String, _
Optional sEmailAddress As String) As String
Dim sContentType As String
Dim sURL As String
Dim aHTTP_ResponseText() As String
Dim iCounter As Long
Dim sFilter As String
Dim Parsed As Dictionary
Dim Values As Variant
Dim Value As Dictionary
Dim varKey As Variant
Dim i As Long
If OAuth2.access_token = "" Then OAuth2_StoredCredentials_Load 'Make sure we have credential before proceeding
If OAuth2_CheckToken = False Then DoCmd.OpenForm sAuthenticationForm, , , , , acDialog 'Force authentication if req'd
sContentType = "application/json"
sURL = "https://graph.microsoft.com/v1.0/users"
'Filters
If sId <> "" Then
If sFilter <> "" Then sFilter = sFilter & " and "
sFilter = sFilter & "id eq '" & sId & "'"
End If
If sGivenName <> "" Then
If sFilter <> "" Then sFilter = sFilter & " and "
sFilter = sFilter & "givenName eq '" & sGivenName & "'"
End If
If sSurname <> "" Then
If sFilter <> "" Then sFilter = sFilter & " and "
sFilter = sFilter & "surname eq '" & sSurname & "'"
End If
If sMobilePhone <> "" Then
If sFilter <> "" Then sFilter = sFilter & " and "
sMobilePhone = Replace(sMobilePhone, "+", "%2B")
sFilter = sFilter & "mobilePhone eq '" & sMobilePhone & "'"
End If
If sEmailAddress <> "" Then
If sFilter <> "" Then sFilter = sFilter & " and "
sFilter = sFilter & "mail eq '" & sEmailAddress & "'"
End If
sURL = sURL & "?$filter=" & sFilter
sURL = sURL & "&$count=true" 'Required for access to certain properties?!
sURL = sURL & "&$select=id"
'Debug.Print sURL
'Call HTTP_SendRequest(sURL, "GET", sContentType, , True)
Call HTTPServer_SendRequest(sURL, "GET", sContentType, , True, Array("ConsistencyLevel,eventual")) 'Special case, requires extra headers!!!
'Call WinHttp_SendRequest(sURL, "GET", sContentType, , True)
If lHTTP_Status = 200 Then
Set Parsed = JsonConverter.ParseJson(sHTTP_ResponseText)
Select Case Parsed("value").Count
Case 0
MsgBox "No matching user found?!"
Microsoft_Users_FindId = 0
Case 1
Microsoft_Users_FindId = Parsed("value")(1)("id")
Case Else
Microsoft_Users_FindId = -9999
ReDim Values(Parsed("value").Count, Parsed("value")(1).Count)
For Each Value In Parsed("value")
i = i + 1
Debug.Print "Contact " & i
For Each varKey In Value.Keys()
If varKey <> "businessPhones" Then
Debug.Print , varKey, Value(varKey)
End If
Next
Next Value
End Select
Set Parsed = Nothing
Else
Debug.Print lHTTP_Status
Debug.Print "--------"
Debug.Print sHTTP_ResponseText
End If
End Function