Un composant activeX ne peut pas créer un objet

**Michel_M** · 15/09/2014, 07h32

Bonjour,

Je viens d'installer OUTLOOK 2007 pour automatiser l'envoi de mail pour mon association 1901, j'ai installé la reférence "Outlook 12.0 Object Library"

Nom : faststone00432.jpg
Affichages : 13669
Taille : 24,1 Ko

Nom : faststone00432.jpg
Affichages : 13669
Taille : 24,1 Ko

j'ai recopié de l' aide DVP ce début de code

Code :

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

1
2
3
4
5
6
7
Sub CreationMailEtLienHypertexte()
    Dim OlApp As Outlook.Application
    Dim OlItem As Outlook.MailItem
    'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
 
    Set OlApp = New Outlook.Application
    Set OlItem = OlApp.CreateItem(olMailItem)

En pas à pas le message "un composant activeX ne peut pas créer un objet..." s'arrête sur la ligne

Code :

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

Set OlApp = New Outlook.Application

Que faire ?

D'avance, Merci

**Daniel.C** · 15/09/2014, 10h28

Bonjour,

Ton code fonctionne avec Office 2013 (en changeant la référence). Si tu as fait un copier / coller, essaie d'entrer en les refrappant les lignes

Code :

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

Dim OlApp As New Outlook.Application

et :

Code :

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

Set OlApp = New Outlook.Application

Sinon, remplace cette ligne par :

Code :

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

Set OlApp = CreateObject("Outlook.Application")

**Michel_M** · 15/09/2014, 18h23

Toujours pareil !

J'ai m^me réecris le début de la procédure sur un nouveau classeur (2007)

Code :

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

1
2
3
4
5
Sub xxx()
Dim Olapp As Object
 
Set Olapp = CreateObject("outlook.application")
End Sub

je vais essayer de passer en CDO mais...

Merci pour tout

Invité · 17/09/2014, 15h39

Bonjour,
supprime ta référence à Outlook tu n'en as pas besoin avec CreateObject!

Code Outlook :

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
Sub Test()
Mail "Sujet", "Message", "Destinataire@gmail.com", Pj:="C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", Pj:="C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm", DestinataireCopy:="DestinataireCopy.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", DestinataireCopy:="DestinataireCopy.com", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com"
End Sub
Sub Mail(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set objOutlook = CreateObject("Outlook.application")
Set MailObj = objOutlook.CreateItem(olMailItem)
With MailObj
    .To = Destinataire
    .CC = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Message
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .Send
End With
End Sub

Code CDO :

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
Sub test()
 MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
End Sub
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
    .Update
 
End With
 
 
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
    .To = Dest
  .cc = DestEnCopy
    .FROM = Expediteur
    .Subject = Objet
'
 
    .HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
    .Send 'envoi du message
 
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Sub

**Michel_M** · 01/10/2014, 07h17

Bonjour,

Un grand merci pour ta solution en CDO!

J'étais passé à autre chose, d'où mon retard, hier,j'avais presque réussi et le dernier obstacle était le passage en html pour éviter les symboles bizarres à la place des caractères accentués; maintenant c'est OK, ouf !

Super

**tyjez** · 13/09/2016, 13h46

pour ma part je passe par outlook car c'est sur une application professionelle sans acces a internet
c'est juste une messagerie interne et oui pour les pieces jointe avec .attachments

Invité · 13/09/2016, 13h49

Envoyé par tyjez

pour ma part je passe par outlook car c'est sur une application professionelle sans acces a internet
c'est juste une messagerie interne et oui pour les pieces jointe avec .attachments

oui mais là je comprend pas ta remarque tu as les 2 version donc tu choisi!

**Godzestla** · 26/04/2017, 09h06

Si vous utilisez comme moi le code CDO donné par rdurupt (Salut !) ou similaire, et que vous l'utilisez en boucle, vous pourriez faire face à un blocage total du code sur

Code :

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

.Send 'envoi du message

à un moment donné de la boucle.

Pour supprimer ce blocage, ajoutez

Code :

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

doevents

après

Code :

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

.Send

mais aussi après

Code :

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

.AddAttachment

Bonne journée.

**Sylvain_cou** · 17/06/2018, 17h57

Bonjour,

Après avoir essayé des envoies de mail par thunderbird qui fonctionne sauf pour des pièces jointes, j'ai tenté la méthode CDO.

Sauf que ! "Le transport a échoué dans sa connexion au serveur"

Voici le code que j'utilise :

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
 objEmail.From = "xxx@xxx.fr"
objEmail.Subject = strSujetMail
objEmail.TextBody = strContenuMail
objEmail.To = "xxx@yahoo.fr"
 
With objEmail.Configuration.Fields
    .Item(CdoConfiguration.cdoSendUsingMethod) = 2
    .Item(CdoConfiguration.cdoSMTPAuthenticate) = 1
    .Item(CdoConfiguration.cdoSendUserName) = "xxx"
    '.Item(CdoConfiguration.cdoSendPassword) = "xxx"
    .Item(CdoConfiguration.cdoSMTPServer) = "smtp.xxxx.fr"
    .Item(CdoConfiguration.cdoSMTPServerPort) = 465
    .Update
End With
objEmail.Send

Je cherche des pistes de solutions.

Merci

**jbuffeteau** · 20/02/2019, 11h39

Bonjour

est-ce que tu as réussi à résoudre ton pb car j'ai la même erreur
Merci beaucoup

**clochette033** · 09/05/2023, 19h18

Bonjour,

Je travaille avec Excel de Office famille et petite entreprise 2021
Sur Windows 10

Voici mon fichier en image

Nom : Sans titre.png
Affichages : 563
Taille : 57,7 Ko

Nom : Sans titre.png
Affichages : 563
Taille : 57,7 Ko

J’aimerais intégrer le code CDO dans ce code pour donner le choix a l’utilisateur entre Outlook et Gmail.

Voici le code original.

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
Sub email()
 'Déclaration des variables
    Dim mamessagerie As Object
    Dim monmessage As Object
    Dim MaSignature As String
    Dim Fichier As Variant
    Dim Fichier2 As Variant
    Dim Fichier3 As Variant
 
 
 
    'on affecte les variables de type objet - initialisation des variables - Set
 
    Set mamessagerie = CreateObject("Outlook.Application")
    Set monmessage = mamessagerie.createitem(0)
    'On affiche le mail
    monmessage.display
    MaSignature = monmessage.HTMLBody
 
    'On construitle message
    With monmessage
    'L'adresse du destinataire
    .to = "email@email.com"
    .CC = "email@email.com"
    MsgBox "Sélectionner l'image 1"
    Fichier = Application.GetOpenFilename("tous les fichiers(*.*),*.*")
     monmessage.attachments.Add Fichier
     If MsgBox("Selectionner l'image 2 ", vbYesNo, "Demande de confirmation") = vbYes Then
         Fichier2 = Application.GetOpenFilename("tous les fichiers(*.*),*.*")
         monmessage.attachments.Add Fichier2
        End If
 
   If MsgBox("Selectionner l'image 3 ", vbYesNo, "Demande de confirmation") = vbYes Then
       Fichier3 = Application.GetOpenFilename("tous les fichiers(*.*),*.*")
       monmessage.attachments.Add Fichier3
        End If
 
 
         'On affiche l'objet du mail
    .Subject = "Retour défectueux" & " " & Range("d10") & " " & Range("d6")
    'on affiche le corps du mail
    .HTMLBody = "<p style='font-family:Calibri;font-size:16'>" & _
    "<br><br>" & "Bonjour" & _
    "<br><br>" & "Nous avons un(des) retour(s) d'item(s) défectueux à faire :" & "<br><br>" & _
    "<br>" & "Quantité:" & " " & Range("g12") & "<br>" & _
    "<br>" & "Sku:" & " " & Range("c12") & "<br>" & _
    "<br>" & "Description du problème:" & "<br>" & _
    Range("b15") & "<br>" & _
    "<br>" & "# Transfert " & " " & Range("d20") & "<br>" & _
    "<br>" & "# de Commande:" & Range("d24") & "<br>" & _
    "Nom de la cliente" & " " & "" & Range("d26") & " " & _
         "<br>" & "Voir photo ci-jointe (1 item) " & "<br><br>" & _
     "<br><br><br><br>" & "Ne pas oublier d'inclure photo du probleme et de l'étiquette." & _
    "<br>" & "Merci et bonne journée!" & "<br><br>" & MaSignature
        'd19 Produit 1 defectueux
        'd20 Produit 1 Raison
    .display 'affiche le mail avant de l'envoyer
    End With
End Sub

Je pensais mettre un MsgBox

'MsgBox Oui + Non
Select Case MsgBox("Choisir oui pour Outlook et non pour gmail", vbYesNo, "Choix de messagerie")
Case vbYes
'procédure si click sur Oui
Le code original

Case vbNo
'procédure si click sur Non

La version gmail.

Dans le code sub test()
MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""

Est-ce que je peux lui dire e prendre les informations de l’onglet donne en g2 pour "My.Mail@gmail.com",
et en f2 pour "Pasw"

Pour le message est-ce que je peux prendre le même code que celui du Outlook
Merci de m’aider
Je suis bloqué.
J’ai beaucoup à apprendre encore.

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
Sub test()
 MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
End Sub
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
    .Update
 
End With
 
 
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
    .To = Dest
 .cc = DestEnCopy
    .FROM = Expediteur
    .Subject = Objet
'
 
    .HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
    .Send 'envoi du message
 
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Sub

**umfred** · 10/05/2023, 18h19

Le code donné plus haut (et il y a plusieurs années) envoie un courrier via l'application outlook, rien à voir (directement) avec une adresse mail outlook.
Dans l'application outlook, on peut y ajouter plusieurs comptes de divers origines. Si dans ton outlook, tu as un compte de messagerie outlook et un compte de messagerie gmail, tu dois pouvoir utiliser le même code (en modifiant l'adresse d'envoi)

**clochette033** · 11/05/2023, 17h45

Envoyé par umfred

Le code donné plus haut (et il y a plusieurs années) envoie un courrier via l'application outlook, rien à voir (directement) avec une adresse mail outlook.
Dans l'application outlook, on peut y ajouter plusieurs comptes de divers origines. Si dans ton outlook, tu as un compte de messagerie outlook et un compte de messagerie gmail, tu dois pouvoir utiliser le même code (en modifiant l'adresse d'envoi)

Bonjour et merci de ton aide

oui mon code fonctionne tres bien avec outlook mais j'ai des utilisateurs qui n'on pas outlook .
je dois leurs donné l'option d'envoyer le e-mail dans gmail.
j'ai pas de formation et j'apprend en cherchant .
je n'arrivais plus a annalyser

je continue de chercher
Merci et bonne journée
Annie

**jurassic pork** · 15/05/2023, 07h32

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. Dans ce cas clochette033 il faudrait que tu ouvres une nouvelle discussion dans le genre "Par quoi remplacer CDO pour envoyer des mails dans VBA sans OutLook" car cela n'a plus du tout rapport avec le sujet initial de la discussion. J'ai une piste

A noter aussi concernant l'utilisation du port 465 ou 587 pour le SMTP gmail :

Is port 465 or 587 better for Gmail?
Port 587 is technically correct, the best kind of correct. However, many ESPs have adopted implicit TLS on port 465. While you can send email over port 25 and 2525, it's much more secure to have the messages encrypted. This makes port 587 the preferred option for sending, with port 465 as a close second

Ami calmant, J.P

Un composant activeX ne peut pas créer un objet

Macros et VBA Excel

Discussions similaires

Partager

Partager