Sub ENVOI_MAIL_2()
AdresDestinMail$ = "gaby3004@hotmail.fr" 'destinataire
AdresMailCC$ = "" 'adres en copie
AdresMailBCC$ = "" 'adres en copie invible
Sujet$ = "Situation du Parking" 'objet du mail
Message$ = "Vous trouverez en Pièce Jointe la dernière Version du Parking" 'message
Chemin$ = "C:\Users\gab.boulou\Desktop\archive parking\" 'dossier complet avec le fichier
EnvoiChemFich$ = LoadCheminFichier$(Chemin$) '<< ce sera le nom complet pour l'envoi
If EnvoiChemFich$ = "" Then MsgBox "Aucun fichier!?", vbExclamation, "envoi": Exit Sub 'quitte
' ENVOI
On Error GoTo ErreurNET
Dim OLApplication As Outlook.Application, OLMail As Outlook.MailItem
Set OLApplication = CreateObject("Outlook.Application")
Set OLMail = OLApplication.CreateItem(OLMailItem)
With OLMail
.To = AdresDestinMail$
.CC = AdresMailCC$
.BCC = AdresMailBCC$
.Subject = Sujet$
.Body = Message$
.Attachments.Add EnvoiChemFich$
.Send '<<<<<<<<< Pour envoye direct(utiliser l'un ou l'autre pas les deux!)
'.Display '<<<<< Pour voir le mail avant envoi
End With
' fin
Set OLApplication = Nothing: Set OLMail = Nothing
On Error GoTo 0: Err.Clear
Exit Sub
ErreurNET: 'sous prog erreur
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear
End Sub
Public Function LoadCheminFichier$(Chemin$)
SvgDir$ = CurDir 'svg chemin en cours
LoadCheminFichier$ = ""
On Error GoTo quit
If Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\"
ChDrive Left(Chemin$, 1): ChDir Chemin$ ' 'place sur le lecteur et position sur le dossier
Fichier$ = Dir(Chemin$ & "*.*")
Dim Dat As Date: Dat = "01/01/1901"
Do While Fichier$ > ""
DateFiche = FileDateTime(Chemin$ & Fichier$)
If DateFiche > Dat Then Dat = FileDateTime(Fichier$): LoadCheminFichier$ = Chemin$ & Fichier$
Fichier = Dir
Loop
quit:
ChDrive Left(SvgDir$, 1): ChDir SvgDir$ 'replace d'origne
End Function