gistfile1.txt

' Add the necessary references to your VBA project:
' - Microsoft XML, v6.0
' - Microsoft Scripting Runtime

Public Function GetOAuth2TokenWithPassword(clientId As String, clientSecret As String, tokenUrl As String, username As String, password As String) As String
    Dim http As Object
    Dim json As Object
    Dim jsonConverter As New JsonConverter
    Dim payload As String
    Dim responseText As String
    Dim token As String

    ' Create the payload for the request
    payload = "grant_type=password&client_id=" & clientId & "&client_secret=" & clientSecret & "&username=" & username & "&password=" & password

    ' Create the HTTP object
    Set http = CreateObject("MSXML2.XMLHTTP.6.0")
    
    ' Open a POST request
    http.Open "POST", tokenUrl, False
    
    ' Set the required headers
    http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
    ' Send the request with the payload
    http.send payload
    
    ' Get the response text
    responseText = http.responseText
    
    ' Parse the JSON response
    Set json = jsonConverter.ParseJson(responseText)
    
    ' Extract the token from the JSON response
    token = json("access_token")
    
    ' Return the token
    GetOAuth2TokenWithPassword = token
End Function

' Example usage
Sub TestGetOAuth2TokenWithPassword()
    Dim clientId As String
    Dim clientSecret As String
    Dim tokenUrl As String
    Dim username As String
    Dim password As String
    Dim token As String

    clientId = "your_client_id"
    clientSecret = "your_client_secret"
    tokenUrl = "https://your.token.url/oauth2/token"
    username = "your_username"
    password = "your_password"

    token = GetOAuth2TokenWithPassword(clientId, clientSecret, tokenUrl, username, password)
    
    ' Display the token
    MsgBox "OAuth2 Token: " & token
End Sub