Discussion :

[Gado2600]

Bonjour,

Certains ordinateurs sont passés sur Outlook (New), qui est la nouvelle version d'Outlook suite à une refonte de Microsoft.

Si on utilise la ligne de commande

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

CreateObject("Outlook.Application")

Cela engendre une erreur VBA.
Sur l'ancienne version d'Outlook, cela ne poser aucun problème.

Et pour cause, New Outlook ne prend pas en charge l'automatisation COM.

De ce fait, je cherche un moyen de contourner cette ligne de commande pour continuer à générer des mails.

En vous remerciant par avance,

[Jean-Philippe André]

Salut,

que fais tu une fois ton application outlook est créée/ouverte ?

Si tu ne fais que créer des emails que tu envoies, tu peux passer par du CDO : https://jdgayot.developpez.com/tutor...ter-cdo/#LVI-A

[jurassic pork]

Hello,

Salut,
Si tu ne fais que créer des emails que tu envoies, tu peux passer par du CDO : https://jdgayot.developpez.com/tutor...ter-cdo/#LVI-A

Hello,
il se pourrait que CDO ne fonctionne plus en SMTP(qui peut me le confirmer ?) et je crois qu'il ne fonctionne pas en port 587.

Ami calmant, J.P

[Thumb down]

Bonjour,
CDO ne prend pas en charge Oauth 2.0 qui est le mode d'authentification par jetons utiliser par la plupart des hébergeurs outlook, gmail, yahoo etc.

Des hébergeurs comme gmail autorisent encore, pour les professionnels, de cocher l'option application moins sécurisée mais plus pour longtemps. Pour le grand public c'est déjà plus possible.

Pour Microsoft je sais pas si l'option est activable.

[Thumb down]

Bonsoir,
voici une piste sur laquelle je travail; pour l'instant je ne l'ai pas résolues!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Sub test()
EnvoyerEmailOAuth "https://exemple.com/token", "smtpserver", 587, "User@Hebrrgeur.com", "Password", "client_id", "client_secret", "Sujet", "destinataire@hebergeurl.com", "Ce mail dans le but de vous dire"
End Sub
 
 
Sub EnvoyerEmailOAuth(url, smtpserver As String, Port, User, Password, client_id, client_secret, Subjec, destinataire, htmlbody)
 
 
    ' Utiliser MSXML2.ServerXMLHTTP pour obtenir le jeton OAuth 2.0
 
 
    ' Construire la requête pour l'obtention du jeton
    Dim requete As Object
    Set requete = CreateObject("MSXML2.ServerXMLHTTP")
 
    ' Configurer la requête OAuth 2.0 (exemple)
 
 
    requete.Open "POST", url, False  ' vba OAuth 2.0
    requete.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    requete.send "grant_type=password&username=" & User & "&password=" & Password & "&client_id=" & client_id & "&client_secret=" & client_secret
 
    ' Traiter la réponse JSON pour obtenir le jeton OAuèth 2.0
    Dim jsonResponse As Object
    Set jsonResponse = ParseJson(requete.responseText)
    Dim accessToken As String
    accessToken = ParseJson("access_token")
 
 
    ' Utiliser le jeton pour envoyer un e-mail via SMTP
    ' Utilisez une bibliothèque compatible avec OAuth 2.0, par exemple CDO.Message
 
 
    Dim objMsg As Object
    Set objMsg = CreateObject("CDO.Message")
 
 
    ' Configurer les paramètres SMTP avec le jeton OAuth 2.0
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 ' CDOBasic
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = accessToken
    objMsg.Configuration.Fields.Update
 
 
    ' Configurer le message
    objMsg.Subject = Subjec '"Sujet de l'e-mail"
    objMsg.From = "expediteur@example.com"
    objMsg.To = destinataire ' "destinataire@example.com"
    objMsg.htmlbody = htmlbody ' "Corps du message"
 
 
    ' Envoyer l'e-mail
    objMsg.send
 
 
End Sub
Function ParseJson(JsonString As String) As Object
    ' Requiert une référence à "Microsoft Scripting Runtime" pour utiliser Dictionary
 
    Dim scriptControl As Object
    Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
 
    scriptControl.Language = "JScript"
 
    Dim jsonResult As Object
    Set jsonResult = scriptControl.Eval("(" & JsonString & ")")
 
    Set ParseJson = ConvertToDictionary(jsonResult)
End Function
 
 
Function ConvertToDictionary(obj As Object) As Object
    ' Convertit un objet JavaScript en objet Dictionary
 
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
 
    Dim key As Variant
    For Each key In obj.Keys
        dict(key) = obj(key)
    Next key
 
    Set ConvertToDictionary = dict
End Function

[Gado2600]

Bonjour,

Navré pour ma réponse tardive. Les journées s'enchainent vite...

Merci pour vos réponses. C'est ce qui m'inquiétait un peu sur la nouvelle gestion à faire sur Outlook...
J'espère qu'ils ne forceront pas le déploiement de celle-ci...

Oui, c'est juste pour de l'envoi de mail mais l'envoi par CDO implique de saisir le mot de passe à un moment où à un autre.
Ce n'est pas pratique côté utilisateur et ça change leurs habitudes sur l'utilisation des outils.

Je vais y réfléchir.

Merci encore pour vos idées !

[cdlr27]

Nouveau sur le sujet, quelle autre solution envoyer des courriels ?

Marcel

[Zebulon777]

Bonsoir,
voici une piste sur laquelle je travail; pour l'instant je ne l'ai pas résolues!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Sub test()
EnvoyerEmailOAuth "https://exemple.com/token", "smtpserver", 587, "User@Hebrrgeur.com", "Password", "client_id", "client_secret", "Sujet", "destinataire@hebergeurl.com", "Ce mail dans le but de vous dire"
End Sub
 
 
Sub EnvoyerEmailOAuth(url, smtpserver As String, Port, User, Password, client_id, client_secret, Subjec, destinataire, htmlbody)
 
 
    ' Utiliser MSXML2.ServerXMLHTTP pour obtenir le jeton OAuth 2.0
 
 
    ' Construire la requête pour l'obtention du jeton
    Dim requete As Object
    Set requete = CreateObject("MSXML2.ServerXMLHTTP")
 
    ' Configurer la requête OAuth 2.0 (exemple)
 
 
    requete.Open "POST", url, False  ' vba OAuth 2.0
    requete.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    requete.send "grant_type=password&username=" & User & "&password=" & Password & "&client_id=" & client_id & "&client_secret=" & client_secret
 
    ' Traiter la réponse JSON pour obtenir le jeton OAuèth 2.0
    Dim jsonResponse As Object
    Set jsonResponse = ParseJson(requete.responseText)
    Dim accessToken As String
    accessToken = ParseJson("access_token")
 
 
    ' Utiliser le jeton pour envoyer un e-mail via SMTP
    ' Utilisez une bibliothèque compatible avec OAuth 2.0, par exemple CDO.Message
 
 
    Dim objMsg As Object
    Set objMsg = CreateObject("CDO.Message")
 
 
    ' Configurer les paramètres SMTP avec le jeton OAuth 2.0
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 ' CDOBasic
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    objMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = accessToken
    objMsg.Configuration.Fields.Update
 
 
    ' Configurer le message
    objMsg.Subject = Subjec '"Sujet de l'e-mail"
    objMsg.From = "expediteur@example.com"
    objMsg.To = destinataire ' "destinataire@example.com"
    objMsg.htmlbody = htmlbody ' "Corps du message"
 
 
    ' Envoyer l'e-mail
    objMsg.send
 
 
End Sub
Function ParseJson(JsonString As String) As Object
    ' Requiert une référence à "Microsoft Scripting Runtime" pour utiliser Dictionary
 
    Dim scriptControl As Object
    Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
 
    scriptControl.Language = "JScript"
 
    Dim jsonResult As Object
    Set jsonResult = scriptControl.Eval("(" & JsonString & ")")
 
    Set ParseJson = ConvertToDictionary(jsonResult)
End Function
 
 
Function ConvertToDictionary(obj As Object) As Object
    ' Convertit un objet JavaScript en objet Dictionary
 
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
 
    Dim key As Variant
    For Each key In obj.Keys
        dict(key) = obj(key)
    Next key
 
    Set ConvertToDictionary = dict
End Function

Bonjour,

est-ce que tu as pu avancé sur cette piste ou est-ce que tu as trouvé une autre solution ?