Envoyer par Outlook des fichiers Excel depuis Access

Version imprimable

06/06/2012, 11h14
Bernard67

Envoyer par Outlook des fichiers Excel depuis Access

Bonjour à toutes et tous

Sur C:\Documents j’ai une 100 de fichiers qui se composent du code client.xls, (ex :28.xls)

Dans Access j’ai une table : T_Mails qui se compose de 2 champs.
Codeclient et destinataire.

Ma question est comment proceder pour que depuis Access, en cliquant sur un bouton, que chaque code client de la table T_Mails cherche le fichier xls correspondant sur C\Documents et l’envoi par Outlook en fichier joint au destinataires qui correspondent à chaque code client.

Merci pour l’aide
06/06/2012, 16h09
Jean-Philippe André

salut,

un peu de rechercher dans la :faq: ave cle mot clé outlook ou mail donne un exemple de code :
http://access.developpez.com/faq/?page=Outlook#outlook
07/06/2012, 08h15
Bernard67

Bonjour et merci pour la reponse jpcheck,

Je me suis mal exprimé, ce n'est pas l'envoi d'un mail que je recherche.

C'est l'automatisation pour l'envoi d'une 100 de fichiers .xls différents à des destinataires différents qui sont dans la table T_Mails
07/06/2012, 09h06
Jean-Philippe André

Tu as les informations dans le lien sur les destinataires, et sur les pièces jointes.

Il ne te reste qu'à faire un recordset qui va chercher les valeurs de ces 2 champs et t les mets en face des trous :ccool:

Merci pour l'aide jpcheck

J'ai bien mes 2 champs :
Code et destinataire.
Maintenant comment chercher les fichiers excel correspondants aux codes clients sur C\documents ?

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
Private Sub Envoi_Mails_Click()
  Dim db As DAO.Database
  Dim rs1 As DAO.Recordset
 
  Dim Numero As Integer
  Dim destinataire As Variant
 
  Set db = Application.CurrentDb
  Set rs1 = db.OpenRecordset("Select * from T_Mails")
 
  rs1.MoveFirst
 
  Do
 
    Numero = rs1("Numero")
    destinataire = rs1("destinataire")
'Verification des procedures
    MsgBox Numero
    MsgBox destinataire
 
    rs1.MoveNext
 
  Loop Until rs1.EOF = True
 
MsgBox "Fin"
 
End Sub

en partant du code de la :faq:

Code:

1
2
3
4
5
CreateEmail( _
    Recipient As String, _
    Subject As String, _
    Body As String, _
    Optional Attach As Variant)

et en utilisant ton début de code, on l'applique avec quelque chose comme

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
Private Sub Envoi_Mails_Click()
  Dim db As DAO.Database
  Dim rs1 As DAO.Recordset
 
  Dim Numero As Integer
  Dim destinataire As Variant
 
  Set db = Application.CurrentDb
  Set rs1 = db.OpenRecordset("Select * from T_Mails")
 
  rs1.MoveFirst
 
  Do
 
    Numero = rs1("Numero")
    destinataire = rs1("destinataire")
'Verification des procedures
    MsgBox Numero
    MsgBox destinataire
 CreateEmail(destinataire, "titre de ton choix","ton corps de mail de ton choix","C:\Documents\" & Numero & ".xls")
    rs1.MoveNext
 
  Loop Until rs1.EOF = True
 
MsgBox "Fin"
 
End Sub

Bonjour le forum, jpcheck.

Avec du retard, voici le code qui fonctionne très bien. Si celui-ci peut etre utile à quelqu'un ou quelqu'une .............

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
Private Sub Envoi_Mails_Click()
'Déclarations obligatoires et préalables
  Dim db As DAO.Database
  Dim rs1 As DAO.Recordset
  Dim spathFichier As String
  Dim sdestinataire As String
  Dim sNomFichier As String
 
   Dim rs As Recordset
 
   Dim objoutlook As Outlook.Application
   Dim objOutlookMsg As Outlook.MailItem
   Dim objOutlookRecip As Outlook.Recipient
   Dim objOutlookAttach As Outlook.Attachment
   Dim outlook_aw As String
   Dim outlook_aww As String
   Dim outlook_ch As String
   Dim outlook_chw As String
   Dim REP As String
   Dim i As Integer
   Dim k As Integer
   Dim outlook_ctr As Integer
   Dim outlook_ctr_ch As Integer
   Dim prem_dest As String
'Variable locale
  Dim Numero As Integer
  Dim destinataire As String
  'Dim Objet As String
  Dim sw_ok As String
  Dim nom_fichier As String
  Dim sw_dest As Integer
 
'Variables qui placent le recordset en mémoire vive
  Set db = Application.CurrentDb
  Set rs1 = db.OpenRecordset("Select * from T_Mails_Clients")
 
'Logiquement Access doit commencer par traiter le 1er enregistrement
'Mais il est préférable de s'en assurer
  rs1.MoveFirst
'Ici, débute la boucle
  Do
  'recherche de la présence d'un fichier excell
   sw_ok = "no"
    Me.code_emet = rs1.Fields("numero")
    nom_fichier = rs1.Fields("numero") & ".xls"
    Me.nom_destinataire = rs1.Fields("destinataire")
 
   GoSub recherche_fichier
 
   If sw_ok = "yes" Then
 
 
    'On injecte le contenu du champ dans une variable
    'Numero = rs1("Numero")
    'destinataire = rs1("destinataire")
 
    GoSub outlook_ouvert
 
   ' Crée la session Outlook.
   Set objoutlook = CreateObject("Outlook.Application")
 
   ' Crée le message.
   Set objOutlookMsg = objoutlook.CreateItem(olMailItem)
 
   With objOutlookMsg
      ' Ajoute le(s) destinataire(s) au message.
      If IsNull(Me.nom_destinataire) = True Or Me.nom_destinataire = "" Then
      Else
 
     i = 1
 
     Do
 
        outlook_aww = Left(Me.nom_destinataire, Len(Me.nom_destinataire))
        outlook_ctr = InStr(i, outlook_aww, ";") - 1
        outlook_aw = Mid(outlook_aww, i, (outlook_ctr - i) + 1)
        Set objOutlookRecip = .Recipients.Add(outlook_aw)
 
        objOutlookRecip.Type = olTo
 
 
        i = outlook_ctr + 2
    Loop Until i >= Len(outlook_aww)
 
 
    ' Définit l'objet, le corps et la priorité du message.
      .Subject = rs1.Fields("object") 'Determine l'objet du mail
            .Body = "Bonjour," & vbCrLf & vbCrLf & "" _
      & "Veuillez trouver ci-joint le fichier du Mois." & vbCrLf & vbCrLf & "" _
      & "Cordialement," & vbCrLf & vbCrLf & "" _
      & "SAV. Tel 01 02 03 04 05" & Chr(10) & Chr(10) & Chr(10) & "" _
      & "SAVDELABOITE@machin.fr" & Chr(10) & Chr(10) & Chr(10)
      .Importance = olImportanceHigh  'Haute
 
 
      ' Ajoute des pièces jointes au message.
 
       ' outlook_aww = Left(Me.outlook_attach, Len(Me.outlook_attach))
       ' outlook_ch = Me.outlook_chemin
       ' outlook_ctr = InStr(i, outlook_aww, ";") - 1
       ' outlook_ctr_ch = InStr(k, outlook_ch, ";") - 1
       ' outlook_aw = Mid(outlook_aww, i, (outlook_ctr - i) + 1)
       ' outlook_chw = Mid(outlook_ch, k, (outlook_ctr_ch - k) + 1)
       Set objOutlookAttach = .Attachments.Add(Me.chemin_stock & nom_fichier)
 
      .Send
      Cancel = True
 
 
    End If
 
    End With
 
   End If
 
   Set objOutlookMsg = Nothing
   Set objoutlook = Nothing
    'On passe à l'enregistrement suivant
    rs1.MoveNext
    'Et ceci jusqu'à la fin du recordset
 
  Loop Until rs1.EOF = True
 
MsgBox "L'envoi des Mails est terminé"
Exit Sub
 
 
outlook_ouvert:
 
On Error Resume Next
 
Dim Ol_App As Outlook.Application
Dim stappname As String
 
Set Ol_App = GetObject(, "Outlook.Application")
 
If Ol_App Is Nothing Then
 stappname = Me.chemin_outlook
 
 Call Shell(stappname, 2)
 
End If
 
Set Ol_App = Nothing
 
Return
 
recherche_fichier:
 
 
With Application.FileDialog(msoFileDialogOpen)
 
Dim doc_cheminw As String
 
doc_cheminw = Me.chemin_stock & "*.xls"
 
 
retour = Dir(doc_cheminw, vbNormal)
 
 
   While retour <> ""
 
    If retour <> "" Then
 
        If retour = nom_fichier Then
            sw_ok = "yes"
            Return
        End If
 
    End If
    retour = Dir()
   Wend
 '   MsgBox retour
 
End With
Return
 
End Sub