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
|
Private Sub B_Envoyer_Click()
On Error GoTo Erreur
'Déclaration des variables
Dim MonOutlook As New Outlook.Application
Dim MonMessage As Outlook.MailItem
Dim MyAttachments As Outlook.Attachments
Dim Msg As String
Dim MsgAuto As String
Dim IntroLibre As String
Dim IntroAuto As String
Dim Signature As String
Dim StrSign As String
Dim Con As ADODB.Connection
Dim Jeu_Enr As ADODB.Recordset
Dim Jeu_Enr_ses As ADODB.Recordset
Dim Txt As String
'Vérification du mode test
If Table_INF = "" Then Table_INF = "INFormation_Locale"
If Chemin = "" Then Chemin = "C:\Export\"
If Me.SES_Num > 0 Then
Me.SES_STA = DLookup("SES_Stage", "SESsions", "SES_Num =" & Me.S_Session)
Me.FOR_Num = DLookup("STA_FOR", "STAge", "STA_Num =" & Me.SES_STA)
End If
'Initialisation des objets
Set MonMessage = MonOutlook.CreateItem(0)
Set MyAttachments = MonMessage.Attachments
Set Con = CurrentProject.Connection
Set Jeu_Enr = New ADODB.Recordset
Set Jeu_Enr_ses = New ADODB.Recordset
'Signature
If UTI_Signature <> "" Then
'MsgBox Environ("appdata")
Select Case DLookup("UTI_Os", "UTIlisateur", "UTI_Num=" & Uti)
Case 1 'Windows 7
StrSign = Environ("appdata") & "\Microsoft\Signatures\" & UTI_Signature
Case 2 'Windows 8
StrSign = Environ("appdata") & "\Microsoft\Signatures\" & UTI_Signature
Case 3 'Winbdows 10
StrSign = Environ("appdata") & "\Microsoft\Signatures\" & UTI_Signature
Case Else
StrSign = ""
End Select
If Dir(StrSign) <> "" Then
Signature = LireSignature(StrSign)
Else
Signature = ""
End If
Else
Signature = ""
End If
'Gestion des pièces jointes
If Me.S_Bulletin_PDF = -1 And SES > 0 Then
DoCmd.OutputTo acOutputReport, "E_Doc_Envoi_Info_Bi", acFormatPDF, Chemin & "Bulletin d'inscription.pdf"
MyAttachments.Add Chemin & "Bulletin d'inscription.pdf"
End If
If Me.S_Programme_PDF = -1 And SES > 0 Then
Num_Formation = Me.FOR_Num
Num_Session = Me.S_Session
If Num_Session > 0 Then
DoCmd.OutputTo acOutputReport, "E_Doc_Programme_Stage_OPQF", acFormatPDF, Chemin & "Programme de formation.pdf"
Else
DoCmd.OutputTo acOutputReport, "E_Doc_Programme_Formation_OPQF", acFormatPDF, Chemin & "Programme de formation.pdf"
End If
MyAttachments.Add Chemin & "Programme de formation.pdf"
End If
SQl = "SELECT " & Table_INF & ".INF_Chemin, " & Table_INF & ".INF_Select, " & Table_INF & ".INF_Désignation" & _
" From " & Table_INF & _
" WHERE (((" & Table_INF & ".INF_Select)=True));"
'Jeu_Enr.Open SQl, Con, adOpenForwardOnly, adLockReadOnly
SQl = "SELECT SESsions.*, REPertoire.*, STAge.*" & _
" FROM STAge RIGHT JOIN (SESsions LEFT JOIN REPertoire ON SESsions.SES_Lieu = REPertoire.REP_Num) ON STAge.STA_Num = SESsions.SES_Stage" & _
" WHERE (((SESsions.SES_Num)=" & Me.S_Session & "));"
'" WHERE (((SESsions.SES_Num)=" & Me.SES_Num & "));"
Jeu_Enr_ses.Open SQl, Con, adOpenForwardOnly, adLockReadOnly
'Création du message
IntroAuto = "<FONT size='2'><FONT face='tahoma'>Bonjour,<br/><br/>Comme convenu, veuillez trouver ci-joints les documents et les informations relatifs à la formation : " & DLookup("STA_Titre", "STAge", "STA_Num =" & Me.SES_STA) & "."
IntroLibre = "Bonjour,"
Do While Not Jeu_Enr_ses.EOF
MsgAuto = MsgAuto & "<br/> - Durée : " & Jeu_Enr_ses!STA_Duree_j & " jour(s)"
MsgAuto = MsgAuto & "<br/> - Lieu : " & Jeu_Enr_ses!REP_Ville
If (Jeu_Enr_ses!STA_Duree_j > 1) Then
MsgAuto = MsgAuto & "<br/> - Dates : Du " & Jeu_Enr_ses!SES_DD & " au " & Jeu_Enr_ses!SES_DF
Else
MsgAuto = MsgAuto & "<br/> - Date : Le " & Jeu_Enr_ses!SES_DD
End If
Jeu_Enr_ses.MoveNext
Loop
If Me.S_Lien_Programme = -1 Then MsgAuto = MsgAuto & "<br/><br/> Vous pouvez également consulter le programme et vous inscrire directement sur notre nouveau site Internet en cliquant sur les liens ci-dessous : <br/> - Pour consulter le programme de la formation : " & "<a href=https://anofab.fr/" & Me.SES_STA & " >Cliquez ici</a><br/>"
If Me.S_Lien_Inscription = -1 Then MsgAuto = MsgAuto & " - Pour vous inscrire par Internet : <a href=http://www.anofab.fr/formation/stage/" & Me.SES_STA & "/" & Me.S_Session & ">Cliquez ici</a>"
'If Me.S_Lien_Inscription = -1 Then MsgAuto = MsgAuto & " - Pour vous inscrire par Internet : <a href=http://www.anofab.fr/formation/stage/" & Me.SES_STA & "/" & Me.SES_Num & ">Cliquez ici</a>"
Select Case Me.S_Type_Message
Case 1 'Message automatique
Msg = IntroAuto & MsgAuto
Case 2 'Message libre
Msg = Me.SAI_Message
Case 3 'Message automatique + message libre
Msg = IntroAuto & MsgAuto & Me.SAI_Message
Case 4 'Message libre + message automatique
Msg = Me.SAI_Message & MsgAuto
Case Else: Exit Sub
End Select
Msg = Msg & "<br/><br/>Je reste à votre disposition pour toute information complémentaire, n'hésitez pas à me contacter.<br/><br/>Bien cordialement,"
With MonMessage
.To = Me.Mail_Destinataire 'Me.s_desMe.Destinataire 'destinataire
.Subject = Me.Objet 'objet
.HTMLBody = Msg & "<br/>" & Signature
.Display
End With
'Déselection des documents
SQl = "UPDATE " & Table_INF & " SET " & Table_INF & ".INF_Select = False" & _
" WHERE (((" & Table_INF & ".INF_Select)=True));"
DoCmd.SetWarnings False 'désactive les messages d'info auto
DoCmd.RunSQL SQl
DoCmd.SetWarnings True 'active les messages d'info auto
'désallocation des objets
'Jeu_Enr.Close
Set MonOutlook = Nothing
Set Con = Nothing
SES = 0
DoCmd.Close acForm, "F_Envoi_Info"
Fermer:
Exit Sub
Erreur:
MsgBox Err.Description
Resume Fermer
End Sub |
