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
| Sub EnvoiMail()
Dim nomfich As String
Dim nomfich2 As String
Dim i As Integer
Dim cellule As String
Dim onglet As Worksheet
Dim Cancel As Boolean
Dim myrep, adresse, sujet, texte, Msg, Style, Title, Response, MyString
Dim destinataire As String, j As Integer
Dim secours As String
Dim expediteur As String
Dim iMsg As Object, iConf As Object, Flds As Object
Const cdoBasic = 1
Msg = "Il faut enregistrer le fichier avant l'envoi" & vbCrLf & vbCrLf & "Confirmez-vous l'enregistrement ?"
Style = vbYesNo + vbInformation ' Définit les boutons.
Title = "Enregistrement du bordereau de visites" ' Définit le titre.
Response = MsgBox(Msg, Style, Title) ' Affiche le message.
If Response = vbYes Then ' L'utilisateur a choisi Oui.
If Dir(Dossier, vbDirectory) <> "" Then
enregistrer3
For Each onglet In Application.ActiveWorkbook.Worksheets
If onglet.Name <> "Fonctionnement" Then
onglet.Select
For i = 10 To 30
cellule = ("I" & i)
If IsEmpty(Range("I" & i)) Then
If IsEmpty(Range("A" & i)) Then
Else
MsgBox ("Il faut absolument que l'observation d'une visite soit renseignée!" & vbCrLf & vbCrLf & "Il faut remplir la cellule " & cellule)
Cancel = True
verif = Range("I" & i).Value
Exit Sub
End If
End If
Next i
End If
Next onglet
If Not verif_Personne Then Exit Sub
Sheets("Fonctionnement").Select
If Not Onglets_2 Then Exit Sub
Else
Msg = "Il faut créer un dossier Bordereau de visites à la racine de d:\" & vbCrLf & vbCrLf & "Souhaitez-vous le créer ?"
Style = vbYesNo + vbInformation ' Définit les boutons.
Title = "Dossier de sauvegarde des bordereaux de visites" ' Définit le titre.
Response = MsgBox(Msg, Style, Title) ' Affiche le message.
If Response = vbYes Then ' L'utilisateur a choisi Oui.
MkDir (Dossier)
Msg = "Le dossier Bordereau de visites a été correctement créé à la racine de d:\" & vbCrLf & vbCrLf & "Souhaitez-vous faire l'enregistrement ?"
Style = vbYesNo + vbInformation ' Définit les boutons.
Title = "Demande de validation" ' Définit le titre.
Response = MsgBox(Msg, Style, Title) ' Affiche le message.
If Response = vbYes Then
enregistrer
Else
MsgBox ("L'enregistrement du bordereau n'a pas eu lieu")
Exit Sub
End If
Else
MsgBox ("L'enregistrement du bordereau ne pourra pas se réaliser")
Exit Sub
End If
End If
Range("C5").Select
Msg = "Confirmez vous l'envoi d'un email pour le fichier" & vbCrLf & fichier
Style = vbYesNo + vbQuestion
Title = "Confirmation envoi email"
Response = MsgBox(Msg, Style, Title) ' Affiche le message.
myrep = Dossier
nomfich = myrep & fichier & ".xlsx"
nomfich2 = Dir(myrep & "*" & fichier & "*.xlsx")
If Response = vbYes Then ' L'utilisateur a choisi Oui.
For j = 1 To 2
On Error Resume Next
If j = 1 Then
expediteur = "toto@free.fr"
destinataire = "titi@free.fr"
texte = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint le bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")" & vbCrLf & vbCrLf & vbCrLf & "Bonne réception." & vbCrLf & vbCrLf & vbCrLf & Representant
Else
destinataire = expediteur 'pour se l'envoyer à soi-même en verification
texte = "ATTENTION !" & vbCrLf & vbCrLf & "Ceci est une copie du message envoyé à tata@free.fr:"
End If
With CreateObject("CDO.Message") 'il faut activer la référence dans outils : Microsoft CDO for Windows 2000 library
Set iMsg = CreateObject("cdo.message")
Set iConf = CreateObject("cdo.configuration")
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'remplacez "smtp.nomserveur.fr" par le nom de serveur de votre FAI :
'http://outlook.developpez.com/faq/index.php?page=Configuration#Paras_FAI
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr"
.Update ' /\
End With ' /
' ici tu dois metre le serveur corespondant a ton fournisseur d'acces______ /
With iMsg
Set .Configuration = iConf
.To = destinataire
.From = destinataire
.Subject = "Bordereau de visites de la semaine " & N_Semaine & " (année " & Annee & ")"
.TextBody = texte
End With
If j = 2 Then MsgBox "Le fichier suivant sera joint au message" & vbCrLf & vbCrLf & nomfich
.AddAttachment nomfich 'ta variable représentant le fichier à joindre
.Send
If Err Then MsgBox "Le message n'a pas pu être expédié.": Exit Sub
' End If
On Error GoTo 0
End With
Next j
MsgBox "Le fichier a logiquement été envoyé et une copie a été adressée à l'adresse " & vbCrLf & vbCrLf & "toto@free.fr"
Else
MsgBox ("L'envoi du bordereau n'a pas eu lieu")
End
End If
Else
MsgBox ("L'envoi du bordereau n'a pas eu lieu")
End
End If
End Sub |
Envoyer via la macro un PJ dans Windows live mail
Répondre avec citation
Partager