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
| Sub EnvoiMail()
Dim nomfich As String, nomfich2 As String, i As Integer, cellule As String, verif
Dim onglet As Worksheet, Cancel As Boolean, myrep As String, texte As String, Msg As String, Style, Title As String, Response As String
Dim destinataire As String, j As Integer, secours As String, 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 'dossier est déclaré ou ?
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)) And IsEmpty(Range("A" & i)) Then
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
Next i
End If
Next onglet
If Not verif_Personne Then Exit Sub ' ça qu'est-ce que c'est
Sheets("Fonctionnement").Select
If Not Onglets_2 Then Exit Sub ' ça qu'est-ce que c'est
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") ' qu'est-ce que c'est ?
If Response = vbYes Then ' L'utilisateur a choisi Oui.
For j = 1 To 2
On Error Resume Next
If j = 1 Then
expediteur = InputBox("choisir l'expéditeur", "EXPEDITEUR", "toto@free.fr") 'mieux vaut inputbox pour controle
destinataire = InputBox("choisir le destinataire", "DESTINATAIRE", "titi@free.fr") 'mieux vaut inputbox pour controle
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é à titi@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
Msg = InputBox("Controler le serveur SMTP", "SERVEUR", "smtp.free.fr")
.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
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
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 |
Partager