[DDE]erreur lors de l'envoi d'un courriel

Version imprimable

Bonjour,
voici mon code que j'utlise pour que l'apllication m'envoie un email lors du transfert d'un employe entre les sites
mon problème vient du fait que ceci ne fonctionne que si outlook est deja ouvert. Dans le cas contraire il m'affiche le bug à la ligne

Code:

Set Couriel = appOutLook.CreateItem(olMailItem)

qu'est ce que ne fonctionne pas??
lorsque j'ouvre le gestionnaire de tâches je vois bien que outlook est en execution. Est ce que quelqu'un aurait une idée ? Merci d'avance
voici mon code

Code:

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
 
Option Compare Database
Dim Libre As Boolean
Private Sub Commande10_Click()
 
 
    Dim Demander As String
 
If Not IsNull(SelectedMatricule.Value) Then
 
    If Me.Site_empl = [Forms]![Menu Général]![SiteChoisi] Then
            MsgBox "L'employé appartient déja à votre site", , "Transfert"
    Else
        Demander = MsgBox("Etes vous sur d'effectuer le transfert?", vbYesNo)
 
 
        If Demander = 6 Then
            Dim I As Integer
            Dim Couriel As Outlook.MailItem
            Dim appOutLook As Outlook.Application
 
            ' créer un nouvel item mail
            Set appOutLook = New Outlook.Application 'createObject("Outlook.Appliction")
 
            Set Couriel = appOutLook.CreateItem(olMailItem)
 
            ' les paramètres
            Couriel.To = "Monadresse"
            Couriel.Subject = "*Transfert*"
 
 
            If Libre Then 'Enregistrer le nouveau site
                Me.Site_empl = [Forms]![Menu Général]![SiteChoisi]
                DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
                Couriel.Body = Me.Nom & " " & Me.Prénom & " " & Me.Matricule & " Appartient à " & Me.Site_empl & " à été transférer vers " & [Forms]![Menu Général]![SiteChoisi]
               ' envoie le message
                Couriel.Send
                MsgBox "Transfert réussie.", , "Transfert"
            Else
                  Couriel.Body = Me.Nom & " " & Me.Prénom & " " & Me.Matricule & " Appartient à " & Me.Site_empl & " Transferer Vers " & [Forms]![Menu Général]![SiteChoisi]
                ' envoie le message
                Couriel.Send
                MsgBox "Transfert réussie, l'employé sera disponible pour votre site dans un délai d'une journée", , "Transfert"
 
 
 
 
            End If
                ' détruit les références aux objets
            Set Couriel = Nothing
            Set appOutLook = Nothing
        End If
    End If
Else
    MsgBox "Veuillez choisir un employé pour le transfert", , "Transfert"
 
End If
Set outlookapp = Nothing
DoCmd.Close acForm, "DNGeneral"
 
End Sub

27/03/2007, 22h28
Heureux-oli

As-tu ajouté les références outlook ?
28/03/2007, 15h10
mahboub

oui ,
j'ai rajouter les réf.érences outlook, ca focntionne tres bien ssi outlook est deja ouvert. je recois mon coureil normalement. mais s'il n'est pas ouvert elle me de donne un bug
dans ton poste tu parle de références avec S moi j'ai rejouté
juste Microsoft outlook 11.0 object library
28/03/2007, 15h16
Heureux-oli

Code:

Set appOutLook = New Outlook.Application 'createObject("Outlook.Appliction")

Sur cette ligne, as-tu essayé le commentaire ou c'est juste un commentaire.

Code:

Set appOutLook = createObject("Outlook.Appliction")

oui j'ai essayer le commentaire, ais il me donne une erreur:
Erreur 429 : Un composant Activex ne peut créer d'objet j'ai chercher sur developpez j'ai trouvé
http://access.developpez.com/faq/?page=Bug#CompActivex
remarque quand je fais un code sur EXCEl[ ca fonctionne correctement meme si outlook est fermer il ouvre outlook et envoi l'email
mais ile en fonctionne pas sur access alors j'ai changer un peu la strcuture ce qui m'a donné le premier code qque j'ai posté
voici mon n code EXCEL

Code:

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
88
89
90
91
92
93
94
Public Sub SCourriel()
 
 Dim outlookapp As Outlook.Application
 Dim myMail  As Outlook.MailItem
 Dim fld As FileDialog
 Dim myNameSpace As Outlook.NameSpace
 Dim mycontact As Outlook.Items '. ContactItem
 Dim Emails  As String
 
 Dim jour As Integer
  Dim jourSemaine As Integer
  Dim send As Boolean
 send = False
On Error GoTo Err
 
'Shell """C:\Program Files\Windows Media Player\wmplayer.exe"" ""E:\chemin\fichier video.avi""", vbMaximizedFocus
 
ThisWorkbook.Activate
 
Set outlookapp = CreateObject("Outlook.Application")
 Set myMail = outlookapp.CreateItem(olMailItem)
 Set fld = Application.FileDialog(msoFileDialogFilePicker)
 
 fld.Filters.Add "fichier EXcel", "*.xls", 1
 fld.InitialFileName = Worksheets("Répertoire").Range("a1")  '"R:\Uncappel\Groupe Gcat\Travail de bureau\charge de travail - centre d'appels\Performance des sites\Montréal Rés"
 If (fld.Show = -1) Then
    myMail.Attachments.Add fld.SelectedItems(1)
    send = True
 
  End If
 
 fld.InitialFileName = Worksheets("Répertoire").Range("a2") '"R:\Uncappel\Groupe Gcat\Travail de bureau\charge de travail - centre d'appels\Performance des sites\Nord-Est Noroît"
 If (fld.Show = -1) Then
    myMail.Attachments.Add fld.SelectedItems(1)
     send = True
  End If
 fld.InitialFileName = Worksheets("Répertoire").Range("a3") '"R:\Uncappel\Groupe Gcat\Travail de bureau\charge de travail - centre d'appels\Performance des sites\Québec"
 If (fld.Show = -1) Then
    myMail.Attachments.Add fld.SelectedItems(1)
     send = True
  End If
  fld.InitialFileName = Worksheets("Répertoire").Range("a4") '"R:\Uncappel\Groupe Gcat\Travail de bureau\charge de travail - centre d'appels\Performance des sites\St-Antoine"
 If (fld.Show = -1) Then
    myMail.Attachments.Add fld.SelectedItems(1)
     send = True
  End If
   fld.InitialFileName = Worksheets("Répertoire").Range("a5") '"R:\Uncappel\Groupe Gcat\Travail de bureau\charge de travail - centre d'appels\Performance des sites\St-Hyacinthe Rés"
 If (fld.Show = -1) Then
    myMail.Attachments.Add fld.SelectedItems(1)
     send = True
  End If
 
 
SigString = "D:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\" & Worksheets("Message").Range("b4") & ".htm"
 
 myMail.BodyFormat = olFormatHTML
 jour = Day(Date)
 jourSemaine = Weekday(Date, vbMonday)
 myMail.To = Worksheets("Message").Range("b1")
 myMail.Subject = Worksheets("Message").Range("b2") & Str(jour + 1 - jourSemaine) & " " & MonthName(Month(Date)) & " " & Year(Date)
 If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
 Else
        Signature = ""
 End If
 myMail.HTMLBody = Worksheets("Message").Range("b3") & Signature
 
  If send = True Then
    myMail.send
    MsgBox "Message envoyé avec succès"
    Else
    MsgBox "Aucun fichier n'est joint, le message ne sera pas envoyé", vbExclamation
  End If
 Set outlookapp = Nothing
 Set myMail = Nothing
 
 Set fld = Nothing
 Set myNameSpace = Nothing
 Set mycontact = Nothing
 Exit Sub
 
Err:
 MsgBox Err.Description & " Une Erreure s'est produitet, le message n'a pas été envoyé", vbExclamation
 
End Sub
Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

28/03/2007, 21h31
Heureux-oli

Essaie de fermer Outlook et de vider l'objet courriel à la fin de ton code.