Peculiarity with Active Authentication issues from VBA

Deriving code-snippets how-to connect + authenticate from SharePoint external automated clients to SharePoint Online, I ran into another peculiarity. This time not on the side of ADFS as STS, but in VBA as automation client. Translating the 'automated client' code from Javascript into Visual Basic for Applications, I quickly had the scenario of Active Authentication with given username and password operational. But next I also wanted to have a working code-snippet for Integrated Active Authentication, based on the NTLM credentials of logged-on interactive user. Only the step to determine the 'saml:Assertion' is here different compared to usernamemixed Active Authentication. However, this first step returned HTTP 401 iso HTTP 200 with the derived 'saml:Assertion'. The request body is correct, as verified via RESTClient.

Logically thinking led to my suspicion that the NTLM credentials of logged-on user are not transmitted from the Excel VBA context. Searching the internet for how-to include the NTLM current credentials in HTTP request from VBA context I found a tip (Windows authentication #15) to use "MSXML2.XMLHTTP" instead of "MSXML2.ServerXMLHTTP.6.0". Bingo, with this change in Request class also from VBA context the Integrated Active Authentication scenario works (already had it proved as working from standalone HTML/Javascript external client.

Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As LongPtr
Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr

Private Function GetO365SPO_SAMLAssertionIntegrated() As String
    Dim CustomStsUrl As String, CustomStsSAMLRequest, stsMessage As String
    
    CustomStsUrl = "https://sts.<tenant>.com/adfs/services/trust/2005/windowstransport"
    CustomStsSAMLRequest = "<?xml version=""1.0"" encoding=""UTF-8""?><s:Envelope xmlns:s=""http://www.w3.org/2003/05/soap-envelope"" xmlns:a=""http://www.w3.org/2005/08/addressing"">" & _
            "<s:Heade>" & _
                "<a:Action s:mustUnderstand=""1"">http://schemas.xmlsoap.org/ws/2005/02/trust/RST/Issue</a:Action>" & _
                "<a:MessageID>urn:uuid:[[messageID]]</a:MessageID>" & _
                "<a:ReplyTo><a:Address>http://www.w3.org/2005/08/addressing/anonymous;</a:Address>;</a:ReplyTo>" & _
                "<a:To s:mustUnderstand=""1"">[[mustUnderstand]];</a:To>" & _
            "</s:Header>"
    CustomStsSAMLRequest = CustomStsSAMLRequest & _
            "<s:Body>" & _
                "<t:RequestSecurityToken xmlns:t=""http://schemas.xmlsoap.org/ws/2005/02/trust"">" & _
                    "<wsp:AppliesTo xmlns:wsp=""http://schemas.xmlsoap.org/ws/2004/09/policy"">" & _
                        "<wsa:EndpointReference xmlns:wsa=""http://www.w3.org/2005/08/addressing"">" & _
                        "<wsa:Address>urn:federation:MicrosoftOnline</wsa:Address>;</wsa:EndpointReference>" & _
                    "</wsp:AppliesTo>" & _
                    "<t:KeyType>http://schemas.xmlsoap.org/ws/2005/05/identity/NoProofKey;</t:KeyType>" & _
                    "<t:RequestType>http://schemas.xmlsoap.org/ws/2005/02/trust/Issue;</t:RequestType>" & _
                "</t:RequestSecurityToken>" & _
            "</s:Body>" & _
        "</s:Envelope>"

    
    stsMessage = Replace(CustomStsSAMLRequest, "[[messageID]]", Mid(O365SPO_CreateGuidString(), 2, 36))
    stsMessage = Replace(stsMessage, "[[mustUnderstand]]", CustomStsUrl)

    ' Create HTTP Object ==> make sure to use "MSXML2.XMLHTTP" iso "MSXML2.ServerXMLHTTP.6.0"; as the latter does not send the NTLM
    ' credentials as Authorization header.
    Dim Request As Object
    Set Request = CreateObject("MSXML2.XMLHTTP")
    
    ' Get SAML:assertion
    Request.Open "POST", CustomStsUrl, False
    Request.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
    Request.send (stsMessage)
    
    If Request.Status = 200 Then
         GetO365SPO_SAMLAssertionIntegrated = O365SPO_ExtractXmlNode(Request.responseText, "saml:Assertion", False)
    End If
    
End Function

Private Function O365SPO_ExtractXmlNode(xml As String, name As String, valueOnly As Boolean) As String
    Dim nodeValue As String
    nodeValue = Mid(xml, InStr(xml, "<" & name))
    If valueOnly Then
        nodeValue = Mid(nodeValue, InStr(nodeValue, ">") + 1)
        O365SPO_ExtractXmlNode = Left(nodeValue, InStr(nodeValue, "</" & name) - 1)
    Else
        O365SPO_ExtractXmlNode = Left(nodeValue, InStr(nodeValue, "lt;/" & name) + Len(name) + 2)
    End If
End Function

Private Function O365SPO_CreateGuidString()
    Dim guid As GUID_TYPE
    Dim strGuid As String
    Dim retValue As LongPtr
    Const guidLength As Long = 39 'registry GUID format with null terminator {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}

    retValue = CoCreateGuid(guid)
    If retValue = 0 Then
        strGuid = String$(guidLength, vbNullChar)
        retValue = StringFromGUID2(guid, StrPtr(strGuid), guidLength)
        If retValue = guidLength Then
            ' valid GUID as a string
            O365SPO_CreateGuidString = strGuid
        End If
    End If
End Function