[WD-2003] Formulaire Envoi Mail validation

[isarian]

Bonjour,

Je viens vers vous pour trouver une solution niveau pratique.

J'ai un formulaire d'absence. Mais voilà comment cela doit se passer.

Un agent fait son bon, il a l'accord de son chef, ca doit aller dans une boite pointage. Ca c'est le cas simple que je sais traiter.

Les cas suivants me posent problème.

Si l'agent n'a pas l'accord de son chef, le bon doit être envoyer uniquement à son chef qui lui valide et si il valide cela doit être envoyer à la boite pointage. Mais bon comment la macro va pouvoir différencier entre le premier et 2 Ieme envoie.

Possibilité 1, mettre un champ caché qui prend différentes valeur suivant le cas.
ou alors

Possibilité 2, faire un bouton supplémentaire pour uniquement le chef.

Que me conseillez vous donc de mettre en place? Pour que pour tout le monde cela soit simple d'utilisation.

Merci d'avance


Voici mon code (il est long car il gère les accents, la sauvegarde du fichier, le chef du service, et l'envoie du 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
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
Private Sub CommandButton1_Click()
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim mareponse
    Dim erreur As Integer
    Dim titreobjet
    Dim Compteur As Integer, Compteur2 As Integer
    Dim NomRep As String
    Dim titrefichier As String
    Dim chefservice As String
 
 
    titreobjet = "Bordereau de correction de pointage " + Environ("USERNAME")
    erreur = 0
 
    'Sauvegarde du fichier
    titrefichier = Format(Date, "yy") & Format(Date, "mm") & Format(Date, "dd") & "-" & Environ("USERNAME") & ".doc"
    'Txt = Dir & "\" & titrefichier
    NomRep = "c:\Bordereau de Correction"
    If Dir(NomRep) = "" Then
 
        'MsgBox "repertoir déja crée"
    Else
        MkDir "c:\Bordereau De Correction"
    End If
 
    If Dir(NomRep & txt) = "" Then
        'MsgBox "Le fichier n'existe pas"
        ActiveDocument.SaveAs FileName:=NomRep & titrefichier
    Else
        'MsgBox "Le fichier " & txt & " Existe"
        Kill (NomRep & txt)
        'MsgBox "Le fichier n'existe plus"
        ActiveDocument.SaveAs FileName:=NomRep & titrefichier
    End If
 
    'Vérification du nom et prénom
    If (ActiveDocument.FormFields("bm_txt_prenom").Result = "Prénom") Or (ActiveDocument.FormFields("bm_txt_prenom").Result = "") Then erreur = 1
    If (ActiveDocument.FormFields("bm_txt_nom").Result = "nom") Or (ActiveDocument.FormFields("bm_txt_nom").Result = "") Then erreur = 1
    mareponse = ActiveDocument.FormFields("bm_txt_prenom").Result + "." + ActiveDocument.FormFields("bm_txt_nom").Result
    'Debug.Print mareponse
 
    'nettoyage de la chaine de caractère pour enlever les Accents
    'DEBUT
    Do
    Compteur = Len(mareponse)
    Compteur2 = InStr(1, mareponse, "-", 1)
    If Compteur2 = 0 Then Exit Do
    mareponse = Mid$(mareponse, 1, Compteur2 - 1) & "" & Mid$(mareponse, Compteur2 + 1, Compteur - (Compteur2))
    Loop
    Do
    Compteur = Len(mareponse)
    Compteur2 = InStr(1, mareponse, "é", 1)
    If Compteur2 = 0 Then Exit Do
    mareponse = Mid$(mareponse, 1, Compteur2 - 1) & "e" & Mid$(mareponse, Compteur2 + 1, Compteur - (Compteur2))
    Loop
    Do
    Compteur = Len(mareponse)
    Compteur2 = InStr(1, mareponse, "è", 1)
    If Compteur2 = 0 Then Exit Do
    mareponse = Mid$(mareponse, 1, Compteur2 - 1) & "e" & Mid$(mareponse, Compteur2 + 1, Compteur - (Compteur2))
    Loop
    Do
    Compteur = Len(mareponse)
    Compteur2 = InStr(1, mareponse, "ç", 1)
    If Compteur2 = 0 Then Exit Do
    mareponse = Mid$(mareponse, 1, Compteur2 - 1) & "c" & Mid$(mareponse, Compteur2 + 1, Compteur - (Compteur2))
    Loop
    'FIN
    mareponse = mareponse + "@blabla.com"
 
    If (ActiveDocument.FormFields("ListeDéroulante1").Result = "Informatique") Then
       chefservice = "informatique@blabla.com"
    End If
 
 
    'Debug.Print chefservice
 
    If (erreur = 0) Then
        Select Case MsgBox("Etes-vous sur?", vbOKCancel, "Envoie par Mail")
 
            'procédure si click sur Ok
            Case vbOK
 
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
 
            With OutMail
                .To = "pointage@blabla.com"
                .CC = LCase(mareponse) + ";" + chefservice
                .BCC = ""
                .Subject = titreobjet
                .Body = "Veuillez trouver en pièce jointe le bordereau de correction de pointage"
                .Attachments.Add ActiveDocument.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send   'or use .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
 
            'procédure si click sur Annuler
            Case vbCancel
                MsgBox ("Le message ne sera pas envoyé")
        End Select
    Else
        MsgBox ("Veuilez Completer le bordereau")
    End If
End Sub

[isarian]

Ps. En fait si je dois faire un champs. Puis je le rendre invisible?

Si oui comment?


Merci de vos aides