Variable pour email en relation avec requete
Bonjour a tous,
Voila, je suis actuellement en train de travailler sur un formulaire sous ACCESS 2002. Et j’ai un petit souci. Etant donné que je n’y connais pas grand-chose en VBA je me retrouve bloqué avec une fonction toute bête…
En effet quand l’utilisateur appui sur un bouton, l’application envoi un mail (la mon ami « rechercher sur le forum » ma trouvé cela) seulement je veux que se mail soit une variable qui en fonction de la personne qui appui sur le bouton, envoi à son supérieur le mail. Vous m’avez suivit ? J’ai créé la requête qui permet de trouver le supérieur hiérarchique que j’ai nommé « Mailchef » et voici le code que j’ai trouvé pour le mail :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| Private Sub btnchef_Click()
On Error GoTo Err_btnchef_Click
Dim MonOutlook As Object
Dim MonMessage As Object
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.createitem(0)
MonMessage.To = ""
MonMessage.Subject = ""
MonMessage.body = ""
MonMessage.Send
Set MonOutlook = Nothing
Exit_btnchef_Click:
Exit Sub
Err_btnchef_Click:
MsgBox Err.Description
Resume Exit_btnchef_Click
End Sub |
Je cherche donc à mettre dans message.To une variable qui est remplie par ma requête. (La requête ne retourne qu’une et une seul personne).
Je tiens à signaler que j’ai déjà cherché sur le forum mais il met encore difficile de tout comprendre, il me semble que se qu’il me manque tiens en à peine deux phase mais mes tentatives on toute échoués donc soit c’est plus compliqué soit sa viens de moi… c’est pourquoi je vous demande un coup de pouce (pas directement la réponse, sinon ce n’est pas amusant ;)
Bonne journée :)
Judit
Edit: Réponse au problème:
Voici le code qui envoi un mail à la personne qui est sont chef de service
(remarque: le corp et le titre du message sont aussi chercher dans la base de données permettant ainsi un envoi de mail automatique mais don le titre et le corp peuvent être changé
)
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
| Option Compare Database
Option Explicit
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Retourne le nom d'usager fourni lors du branchement au réseau.
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function
Private Sub btnchef_Click()
On Error GoTo Err_btnchef_Click
'déclaration
Dim MonOutlook As Object
Dim MonMessage As Object
Dim strUserWindows As String
Dim varNumChef As Variant
Dim varEmailSuperieur As Variant
Dim varSujet As Variant
Dim varCorp As Variant
'utilisateur courant
strUserWindows = Environ("UserName")
'définire qui est le chef de service pour l'utilisateur windows
varNumChef = DLookup("Numchefservice", "Employe", "Id_windowsEmp='" & strUserWindows & "'")
If IsNull(varNumChef) Then
MsgBox "Pas d'employé trouvé pour l'identifiant Windows"
Exit Sub
End If
'trouve l'adresse mail correspondant au chef de service
varEmailSuperieur = DLookup("mailchef", "ChefService", "NumChef=" & varNumChef)
If IsNull(varEmailSuperieur) Then
MsgBox "Adresse email non trouvée"
Exit Sub
End If
'definie se qui doit etre mis dans le mail (titre et corp)
varSujet = DLookup("Libellétitre", "TitreMessage", "NumTitre=1")
varCorp = DLookup("libellécorp", "corpmessage", "numcorp=1")
'Message en cas de mail non trouvé
If IsNull(varEmailSuperieur) Then
MsgBox "Adresse email non trouvée"
Exit Sub
End If
'envoi du mail
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.createitem(0)
MonMessage.To = varEmailSuperieur
MonMessage.Subject = varSujet
MonMessage.body = varCorp
MonMessage.Send
Set MonOutlook = Nothing
Exit_btnchef_Click:
Exit Sub
Err_btnchef_Click:
MsgBox Err.Description
Resume Exit_btnchef_Click
End Sub |
