M365 New Outlook versie en mail versturen.

[test1000]

Hoi,

Zie ook onderstaande link.

Een Access programma met de 'juiste' code om mails te versturen vanuit Microsoft Access.
Alles werkt perfect.
Wanneer de gebruiker nu de Nieuwste versie van M365 selecteert, via de slider 'naar New Version', dan wordt er geen mails verstuurd vanuit Microsoft Access.

Via SMTP kan ik mails versturen maar worden de mails 'onmiddellijk' verstuurd. Maw de gebruiker kan geen extra info toevoegen aan de mail. Nu heeft de gebruiker wel de mogelijkheid om extra info of bijlagen toe te voegen via de .Display code.

En dat zouden wij graag willen behouden.
Via Java kan er ook blijkbaar mails verstuurd worden maar ....... heb ik 'notice' van.

Wie kan mij in de juiste richting sturen zodat ook met de nieuwste M365 Outlook versie de mail wordt 'weergegeven' en de gebruiker nog zelf op de knop [Verzenden] moet klikken ?

Deze 'discussie' gevonden met hetzelfde probleem

Om deze inhoud te bekijken, hebben we jouw toestemming nodig om cookies van derden te gebruiken.
Voor meer gedetailleerde informatie, zie onze cookiespagina.

Accepteer cookies van derden

Alvast bedankt voor jullie hulp.

 

[OctaFish]

Fijn dat je het probleem elders ook gelokaliseerd hebt, maar zonder code kunnen we natuurlijk niks. Ik wil dan op zijn minst jouw procedure zien die met de gewone Outlook wél werkt, maar met de nieuwe niet. Zodat ik zelf kan testen.

 

[xps351]

En heb je de opties die daar genoemd worden geprobeerd?

 

[OctaFish]

Lijken mij geen opties die je zou moeten overwegen. Ik wil liever toch de code van TS zien, en het zelf testen (en oplossen).

 

[test1000]

Hier de code.
Er wordt een draft mail aangemaakt. Dus nog niet 100% in orde maar werkbaar.


Deze code hebt ik 'uitgezet' omdat de link niet kan geopend worden maar de mail staat wel in de 'concepten' folder.

        'Application.FollowHyperlink draftLink

Dus deze code werkt. Er staat in Outlook een 'draft' mail klaar.
Maar normaal gezien zou deze draft mail opgehaald moeten worden met bovenstaande code maar dan krijg ik foutmelding dat id niet kan worden gevonden.

Dus hopelijk is er iemand die de code kan aanpassen zodat het wel werkt.
Met Shell ed werkt het ook niet.
Wij werken met M365 Outlook en MFA.

Option Compare Database
Option Explicit
' Define constants for OAuth2 authentication
Private Const CLIENT_ID As String = "XXXXXXX"
Private Const TENANT_ID As String = "XXXXXXX"
Private Const CLIENT_SECRET As String = "XXXXXXXXXX" ' Update with your client secret
Private Const AUTHORITY As String = "https://login.microsoftonline.com/" & TENANT_ID
Private Const TOKEN_ENDPOINT As String = AUTHORITY & "/oauth2/v2.0/token"
Private Const SCOPE As String = "https://graph.microsoft.com/.default"

Sub CreateDraftEmail()
    Dim accessToken As String
    Dim xmlhttp As Object
    Dim emailJson As String
    Dim subject As String
    Dim bodyContent As String
    Dim recipientEmail As String
    Dim draftId As String
    Dim response As Object
    Dim userEmail As String

    userEmail = "XXXXXXXXXXX" ' Update this to the sender's email address

    accessToken = GetAccessToken()
    If accessToken = "" Then
        MsgBox "Failed to acquire access token."
        Exit Sub
    End If

    subject = "XXXXXXXXX"
    bodyContent = "XXXXX" & vbCrLf & vbCrLf & _
                  "XXXXX" & vbCrLf & vbCrLf
    recipientEmail = "XXXX"

    bodyContent = Replace(bodyContent, vbCrLf, "\n")
    bodyContent = Replace(bodyContent, vbLf, "\n")

    emailJson = "{""subject"":""" & subject & """,""body"":{""contentType"":""Text"",""content"":""" & bodyContent & """},""toRecipients"":[{""emailAddress"":{""address"":""" & recipientEmail & """}}]}"

    Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xmlhttp.Open "POST", "https://graph.microsoft.com/v1.0/users/" & userEmail & "/messages", False
    xmlhttp.setRequestHeader "Authorization", "Bearer " & accessToken
    xmlhttp.setRequestHeader "Content-Type", "application/json"
    xmlhttp.Send emailJson

    If xmlhttp.status = 201 Then
        Set response = JsonConverter.ParseJson(xmlhttp.responseText)
        draftId = response("id")
        MsgBox "Draft created successfully. Draft ID: " & draftId
        Open the draft email in Outlook for the user to edit
        Dim draftLink As String
        draftLink = "https://outlook.office.com/mail/inbox/id/" & draftId
        Debug.Print "Draft Link: " & draftLink
        'Application.FollowHyperlink draftLink
    Else
        MsgBox "Failed to create draft. Status: " & xmlhttp.status & " Response: " & xmlhttp.responseText
    End If

    Set xmlhttp = Nothing
    Set response = Nothing
End Sub

 

[OctaFish]

Je gebruikt een extra functie (GetAccessToken) die er niet bij zit. Dus ik kan deze code zeker niet testen.

 

[test1000]

Sorry, hier de code.

' Function to get the OAuth2 access token
Function GetAccessToken() As String

Dim xmlhttp As Object
Dim postData As String
Dim tokenResponse As Object
Dim status As Long

' Prepare POST data
postData = "grant_type=client_credentials" & _
"&client_id=" & CLIENT_ID & _
"&client_secret=" & CLIENT_SECRET & _
"&scope=" & SCOPE

' Initialize XMLHTTP object
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlhttp.Open "POST", TOKEN_ENDPOINT, False
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.Send postData

' Check status
status = xmlhttp.status
Debug.Print "HTTP Status: " & status
Debug.Print "Response: " & xmlhttp.responseText

' Parse JSON response
If status = 200 Then
Set tokenResponse = JsonConverter.ParseJson(xmlhttp.responseText)
GetAccessToken = tokenResponse("access_token")
Else
GetAccessToken = ""
MsgBox "Failed to acquire access token. Status: " & status & " Response: " & xmlhttp.responseText
End If

' Clean up
Set xmlhttp = Nothing
Set tokenResponse = Nothing
End Function

 

[OctaFish]

Zal morgen eens testen. Overigens ben je vergeten om de code tussen CODE tags te zetten. Dat ziet er echter toch een stuk netter uit .