Date: 2026-04-29
Scope: Src/Graph.bas, Src/AttachmentHelpers.bas, Src/TimeZoneHelpers.bas, authenticators/GraphAuthenticator.cls, authenticators/OAuth2Authenticator.cls
References: Microsoft Graph best practices, Graph throttling guidance, OAuth2 auth code flow
Apply these in order — the top items cause active crashes or data loss in production.
Scopes(1)→VBA.Join(Me.Scopes, " ")— crashes with a single scopeReplace(fillString, " ", "")→Split/Trim— corrupts every attachment path with spaces- Add
= "Error"sentinel toGetContactFolderID/GetMailFolderID— infinite loop in production - Add
MAX_RETRIEScap to all 8 public Graph functions — infinite loop on persistent 401 - Move
client_secretfrom URL querystring to POST body (OAuth2Authenticator) - Fix
"Top"→"$top"—$topis always silently ignored; lists are always page-capped - Add
@odata.nextLinkpagination loop — data silently truncated beyond first page - Add HTTP 429 +
Retry-Afterhandling
' Current (INSECURE):
auth_Request.AddQuerystringParam "client_secret", Me.ClientSecretQuery strings are captured in proxy logs, server access logs, browser history, and HTTP Referer headers. The client_secret must be sent in the POST body.
' Fix — use body parameter instead:
auth_Request.AddBodyParameter "client_secret", Me.ClientSecret
' Remove the AddQuerystringParam line above.pClientSecret = DLookup("ClientSecret", "AdminTable")Any user who can open the .accdb file can read the secret from AdminTable. At minimum, encrypt the value using Windows DPAPI (CryptProtectData / CryptUnprotectData). Better: store it in the Windows Credential Manager and retrieve via CredRead (WinAPI Declare PtrSafe).
auth_Request.AddQuerystringParam "grant_type", "password"Microsoft explicitly deprecates ROPC for production. It bypasses MFA, does not support Conditional Access policies, and routes raw user credentials through the application. Use authorization_code (interactive) or client_credentials (service-to-service) flows instead.
Public Token As StringAny VBA code in the same project can read or overwrite the live bearer token.
' Fix — encapsulate:
Private pToken As String
Public Property Get Token() As String
Token = pToken
End Property
' Only set pToken internally via Friend/Private methods.AddScope builds a 0-based array. With a single scope (e.g., .default for client_credentials), Scopes(1) raises runtime error 9 — Subscript out of range. With multiple scopes, Scopes(0) (the first scope) is silently dropped.
' Current:
auth_Body.Add "scope", Me.Scopes(1)
' Fix — join all scopes space-separated per OAuth2 spec:
auth_Body.Add "scope", VBA.Join(Me.Scopes, " ")' Current — hangs Access forever if token keeps failing:
While sStatus = "Retry"
Set CreateDraftMessage = Client.Execute(Request)
If CreateDraftMessage.StatusCode = WebStatusCode.Unauthorized _
And InStr(CreateDraftMessage.Content, "expired") Then
ClearAuthCodes
sStatus = "Retry"
Else
sStatus = "Done"
End If
Wend' Fix — cap retries:
Const MAX_RETRIES As Integer = 2
Dim nRetry As Integer
nRetry = 0
Do
Set CreateDraftMessage = Client.Execute(Request)
If CreateDraftMessage.StatusCode = WebStatusCode.Unauthorized _
And InStr(CreateDraftMessage.Content, "expired") _
And nRetry < MAX_RETRIES Then
ClearAuthCodes
nRetry = nRetry + 1
Else
Exit Do
End If
LoopApply the same pattern to GraphSendMail, GetGroupID, GetCalendarGroupID, GetCalendarID, GetContactFolderID, GetMailFolderID, ListMessages, and CreateEvent.
When the named folder does not exist, the loop completes the For Each without setting the return value away from "Retry", so the While condition remains true and loops forever. Compare GetGroupID, which correctly assigns = "Error" after exhausting the list.
' Add immediately after the Next FolderInfo line:
If GetContactFolderID = "Retry" Then GetContactFolderID = "Error"
' (same pattern for GetMailFolderID)' Current — destroys paths like "C:\My Documents\report.pdf":
fillString = Replace(fillString, " ", "")The intent was to normalise spacing around the ; delimiter. Fix: split on ";" and Trim each token.
' Fix:
Dim aPaths() As String
aPaths = Split(fillString, ";")
Dim i As Long
For i = LBound(aPaths) To UBound(aPaths)
Dim sPath As String
sPath = Trim(aPaths(i))
If sPath = "" Then GoTo NextPath
Set attachment = New Dictionary
attachment.Add "@odata.type", "#microsoft.graph.fileAttachment"
attachment.Add "name", Mid(sPath, InStrRev(sPath, "\") + 1)
attachment.Add "contentBytes", ConvertFileToBase64(sPath)
fillCollection.Add attachment
NextPath:
Next iThe same fix applies to FillEmailAddressCollection and FillAttendeeCollection which use the identical Replace(fillString, " ", "") pattern.
Without Randomize, VBA's Rnd produces the same sequence on every session start. GUIDs collide across sessions.
' Fix — minimum:
Public Function CreateGUID() As String
Randomize
...
' Better — truly random:
Public Function CreateGUID() As String
CreateGUID = CreateObject("Scriptlet.TypeLib").GUID
CreateGUID = Mid(CreateGUID, 2, Len(CreateGUID) - 2) ' strip braces
End FunctionOData system query options require the $ prefix. "Top" (without $) is not a recognised parameter and is silently ignored — the server applies its own default page size (100 items).
' Current:
Request.AddQuerystringParam "Top", 1000
' Fix:
Request.AddQuerystringParam "$top", 1000The Graph event schema defines allowNewTimeProposals as a Boolean. Sending "true" (a JSON string) is schema-invalid.
' Current:
.AddBodyParameter "allowNewTimeProposals", "true"
' Fix:
.AddBodyParameter "allowNewTimeProposals", True' Current — misleading; creates a new instance then immediately discards it:
Public Sub ClearAuthCodes()
Dim Auth As New GraphAuthenticator
Set Auth = Client.Authenticator
Call Auth.ClearCodes
End SubFunctionally correct but allocates an unused object. Prefer:
Public Sub ClearAuthCodes()
Dim Auth As GraphAuthenticator
Set Auth = Client.Authenticator
Auth.ClearCodes
End SubIf Now > dtEnd Then
Err.Raise 11042 + vbObjectError, "OAuthDialog", "Login error: Wait time exceeded."
Exit Do ' ← never reached; Err.Raise with active On Error GoTo transfers immediately
End IfThe Exit Do is unreachable dead code. Remove it to avoid misleading readers.
Private sSessionID As String ' always ""
' Logout navigates to:
"https://m365.cloud.microsoft/estslogout?ru=%2F&sessionId="sSessionID is declared but never assigned anywhere in the class. The logout URL is always missing the session ID. The session ID should be captured from the login response URL or the ID token claims.
Graph API pages results. Default page sizes are 10 (messages), 100 (contacts, groups, calendars). When results exceed one page, the response includes @odata.nextLink. None of the list functions follow nextLink — only the first page is ever returned.
' Fix pattern — add after the OK branch:
Dim sNextLink As String
sNextLink = ""
If Response.Data.Exists("@odata.nextLink") Then
sNextLink = Response.Data("@odata.nextLink")
End If
' Continue looping while sNextLink <> ""Graph throttling guidance requires honouring the Retry-After response header on HTTP 429. All retry loops only handle 401 — a 429 falls through to sStatus = "Done" and the call silently fails.
' Add 429 handling to every retry loop:
ElseIf Response.StatusCode = 429 Then
' Retry-After header not directly accessible via VBA-Web without extension;
' fall back to a fixed wait or parse from Response.Headers collection.
Application.Wait Now + TimeValue("0:00:30") ' 30-second back-off
' Loop again (do not set sStatus = "Done")Request.Resource = "/groups" ' fetches ALL groups; filters client-sideFor large tenants this can be thousands of objects across multiple pages. Use server-side filtering:
Request.AddQuerystringParam "$filter", "displayName eq '" & sGroup & "'"
Request.AddQuerystringParam "$select", "id,displayName"
Request.AddQuerystringParam "$count", "true"
Request.SetHeader "ConsistencyLevel", "eventual"Every GET request omits $select, causing Graph to return all fields (including large body content for messages). Per Microsoft best practices: "Choose only the properties your application really needs."
Example for listing contacts:
Request.AddQuerystringParam "$select", "id,displayName,emailAddresses,businessPhones"Microsoft support correlates server-side traces using the client-request-id request header. Without it, troubleshooting failed API calls is very difficult.
Request.SetHeader "client-request-id", CreateGUID()' Auth.AddScope "offline_access" 'if using Refresh TokenWithout offline_access the authorization server does not issue a refresh token. When the access token expires (~1 hour), the only recovery is a full interactive re-login. Uncomment this scope and implement the refresh token flow.
'.AddBodyParameter "transactionId", CreateGUID() ' ← commented outWithout a transactionId, a network failure mid-request leaves the client unable to determine whether the event was created. Retrying creates duplicate calendar events. Uncomment this after fixing CreateGUID (§2.5).
pClient.BaseUrl = "https://graph.microsoft.com/v1.0"Extract to a named constant and expose as an overridable property:
Private Const GRAPH_BASE_URL As String = "https://graph.microsoft.com/v1.0"If .LoadFromFile fails (file not found, permission denied), the With block exits without calling .Close, leaking the COM reference.
' Fix:
Public Function ConvertFileToBase64(sPath As String) As String
Dim oStream As Object
Set oStream = CreateObject("ADODB.Stream")
On Error GoTo Cleanup
oStream.Open
oStream.Type = 1 ' adTypeBinary
oStream.LoadFromFile sPath
Dim bytes As Variant
bytes = oStream.Read
oStream.Close
ConvertFileToBase64 = EncodeBase64(bytes)
GoTo Done
Cleanup:
On Error Resume Next
oStream.Close
On Error GoTo 0
Err.Raise Err.Number, Err.Source, Err.Description
Done:
Set oStream = Nothing
End FunctionGraph API rejects fileAttachment objects larger than 3 MB. Files larger than that require the upload session API. No size check exists.
' Add before ConvertFileToBase64 call:
Const MAX_INLINE_BYTES As Long = 3 * 1024 * 1024 ' 3 MB
If FileLen(sPath) > MAX_INLINE_BYTES Then
Err.Raise vbObjectError + 9001, "FillAttachmentCollection", _
"File """ & sPath & """ exceeds 3 MB. Use upload session API for large attachments."
End IfIf AdminTable credentials change at runtime, the cached pClient continues with stale credentials forever.
' Add to Graph.bas:
Public Sub Reset()
Set pClient = Nothing
pClientId = ""
pTenantID = ""
pClientSecret = ""
pGrantType = ""
End SubThe token response includes expires_in (seconds until expiry), but it is never stored or used. Tokens are only cleared after a 401 — meaning in-flight requests can fail mid-execution when the token expires.
' In GraphAuthenticator.cls, add:
Private pTokenExpiry As Date
' In GetToken, after successful response:
pTokenExpiry = DateAdd("s", CLng(auth_Response.Data("expires_in")) - 60, Now)
' In IWebAuthenticator_BeforeExecute, replace:
If Me.Token = "" Then
' With:
If Me.Token = "" Or Now >= pTokenExpiry Then
Me.Token = Me.GetToken(Client)
End IfIf pGrantType = "" Then pGrantType = DLookup("GrantType", "AdminTable")The Client property getter already sets pGrantType during lazy initialisation. This guard fires only if pClient was somehow reset without using Reset() (no such code path exists). These DLookup calls are unnecessary DAO overhead in every public function call. Trust the Client getter to initialise all module-level state; remove the per-function guards.
Used in 8+ retry loops. The AAD error body wording can change. Prefer checking the structured error code from the JSON response:
' More robust check using AAD error codes:
If Response.StatusCode = WebStatusCode.Unauthorized Then
' AAD returns error_codes like 700082 (refresh token expired), 70008, etc.
If Response.Data.Exists("error") Then
If InStr(Response.Data("error")("code"), "InvalidAuthenticationToken") > 0 _
Or InStr(Response.Data("error")("code"), "TokenExpired") > 0 Then
' clear and retry
End If
End If
End If' Current — each & allocates a new string copy:
For N = LBound(V) To UBound(V)
S = S & Chr(V(N))
Next NFor the 32-element timezone name array this is negligible, but the pattern is incorrect. Use StrConv on a byte array:
Function IntArrayToString(V As Variant) As String
Dim buf() As Byte
Dim N As Long
ReDim buf(LBound(V) To UBound(V))
For N = LBound(V) To UBound(V)
buf(N) = V(N) And 255
Next N
' Trim trailing null chars from fixed-length Win32 string buffer
IntArrayToString = Left$(StrConv(buf, vbUnicode), _
InStr(StrConv(buf, vbUnicode), Chr$(0)) - 1)
End Function| # | File | Issue | Severity |
|---|---|---|---|
| 1.1 | OAuth2Authenticator.cls |
client_secret in URL querystring |
CRITICAL |
| 1.2 | Graph.bas |
ClientSecret plaintext in AdminTable |
CRITICAL |
| 1.3 | OAuth2Authenticator.cls |
ROPC (grant_type=password) flow deprecated |
HIGH |
| 1.4 | GraphAuthenticator.cls |
Public Token As String — no encapsulation |
HIGH |
| 2.1 | GraphAuthenticator.cls |
Scopes(1) off-by-one — crash or dropped scope |
CRITICAL |
| 2.2 | Graph.bas |
Infinite retry loop on persistent 401 | HIGH |
| 2.3 | Graph.bas |
GetContactFolderID/GetMailFolderID infinite loop when not found |
HIGH |
| 2.4 | Graph.bas |
Replace(fillString, " ", "") corrupts paths with spaces |
HIGH |
| 2.5 | Graph.bas |
Rnd without Randomize — deterministic GUIDs |
HIGH |
| 2.6 | Graph.bas |
"Top" instead of "$top" — $top always ignored |
MEDIUM |
| 2.7 | Graph.bas |
allowNewTimeProposals sent as string not Boolean |
MEDIUM |
| 2.8 | Graph.bas |
Dim Auth As New before Set Auth = — misleading |
LOW |
| 2.9 | GraphAuthenticator.cls |
Dead Exit Do after Err.Raise |
LOW |
| 2.10 | GraphAuthenticator.cls |
sSessionID never set — Logout URL always invalid |
LOW |
| 3.1 | Graph.bas |
No $filter on /groups — full client-side scan |
HIGH |
| 3.2 | Graph.bas |
No HTTP 429 / Retry-After handling |
HIGH |
| 3.3 | Graph.bas |
No @odata.nextLink pagination — data truncated |
HIGH |
| 3.4 | Graph.bas |
No $select projections — all fields fetched |
MEDIUM |
| 3.5 | Graph.bas |
No client-request-id header — diagnostics blocked |
MEDIUM |
| 3.6 | GraphAuthenticator.cls |
offline_access commented out — no refresh token |
MEDIUM |
| 3.7 | Graph.bas |
transactionId commented out — duplicate events on retry |
MEDIUM |
| 3.8 | Graph.bas |
Base URL hardcoded with no abstraction | LOW |
| 4.1 | AttachmentHelpers.bas |
ADODB.Stream COM leak on error |
MEDIUM |
| 4.2 | AttachmentHelpers.bas |
No 3 MB attachment size guard | MEDIUM |
| 4.3 | Graph.bas |
No Reset() method for singleton pClient |
LOW |
| 4.4 | GraphAuthenticator.cls |
expires_in never stored — reactive-only token refresh |
MEDIUM |
| 4.5 | Graph.bas |
Redundant DLookup in 8+ functions |
LOW |
| 4.6 | Graph.bas |
Fragile InStr(..., "expired") for error detection |
MEDIUM |
| 4.7 | TimeZoneHelpers.bas |
O(n²) string concatenation + trailing null chars | LOW |