Bonjour à tous,
J'espère que vous allez bien.
Suite à l'aide d'un membre de la communauté (encore merci), j'ai pu réussir à mettre en place ma macro afin pour envoyer des mails de façon automatique. Cependant je rencontre un problème.. En effet j'ai mis mon fichier en format Path, lorsque je reçois mon mail, le chemin d'accès n'est pas cliquable, je dois faire un copier/coller dans l'Explorateur de Fichier. Il y a t-il une solution afin que je puisse rendre ce chemin d'accès cliquable svp ? J'ai essayé de voir avec A Href mais ça ne semble pas marcher...
Le code ci-dessous :
Sub Test() 'var& =long, var% =entier, var$ alphanum
'test si c'est une feuil "KM 0000"
If Left(LCase(ActiveSheet.Name), 2) <> "km" Then MsgBox "Cette feuille n'est pas une Feuille Kilometrage !": Exit Sub
'------------------------------------------
Dim Message As String
Dim NoColAdres%, NoColDesNoms%, NoPremColMois%, NoPremLig%, NoDernLig&, MoisEnCours%
NoColAdres = 1 'Col(A)
NoColDesNoms = 2 'Col(B)
NoPremColMois = 5 'Col(E)
NoPremLig = 11 ' 1'lig du tableau
NoDernLig = Range("A" & Rows.Count).End(xlUp).Row
'mois en cours
MoisEnCours = Month(Date)
NoColMoisEnCours = NoPremColMois + MoisEnCours - 1
Moi$ = Cells(NoPremLig - 1, NoColMoisEnCours)
'si ligne inférieure tableau, exit
If NoDernLig < NoPremLig Then MsgBox "Aucune donnée en cours !?": Exit Sub
'boucle sur le tableau
For I = NoPremLig To NoDernLig
Nom$ = Cells(I, NoColDesNoms) 'nom
Adres$ = Cells(I, NoColAdres) 'adres
M$ = Cells(I, NoColMoisEnCours) 'contenu lig/col du mois
'si mois en cours vide envoi mail
If M$ = "" Then
Message = "Le fichier à compléter pour le mois " & Moi$ & " est le suivant: " & vbLf & _
ThisWorkbook.Path & "\" & ThisWorkbook.Name & vbLf & vbLf & _
"<p>Merci par avance.</p>"
'MsgBox Message
EnvoyerEmail Nom$, Adres$, Message
End If
Next
End Sub
Sub EnvoyerEmail(ByVal NomContact As String, ByVal Destinataire As String, ByVal Message As String)
'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'On déclare les variables
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim strRelance As String
'On ouvre un nouvel email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'On indique le corps du mail avec du HTML
strbody = "<HTML><BODY><H4>Bonjour " & NomContact & ",</H4><p>L'échéance arrivant à termes, merci de remplir le document approprié par la suite.</p>" & _
Message
'Si erreur pas au code suivant
On Error Resume Next
'Ce code permet l'ajout de la signature dans le corps du texte
With OutMail
.Importance = 2
.Display 'Affiche la fenêtre du mail | Obligatoire pour ajouter la signature, à masquer si pas nécessaire
.To = Destinataire 'Le ou les destinataire(s) du mail
.CC = "" 'La ou les personne(s) en copie du mail
.Subject = "Rappel échéance kilométrage véhicule" 'L'objet du mail
.HTMLBody = strbody & .HTMLBody 'Le corps du mail + signature
.ReadReceiptRequested = True
' .Send 'Envoie du mail automatique
End With
Application.DisplayAlerts = True
On Error GoTo 0
'on vide les variables objet
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
En vous remerciant par avance et bonne journée
Bien à vous.
J'espère que vous allez bien.
Suite à l'aide d'un membre de la communauté (encore merci), j'ai pu réussir à mettre en place ma macro afin pour envoyer des mails de façon automatique. Cependant je rencontre un problème.. En effet j'ai mis mon fichier en format Path, lorsque je reçois mon mail, le chemin d'accès n'est pas cliquable, je dois faire un copier/coller dans l'Explorateur de Fichier. Il y a t-il une solution afin que je puisse rendre ce chemin d'accès cliquable svp ? J'ai essayé de voir avec A Href mais ça ne semble pas marcher...
Le code ci-dessous :
Sub Test() 'var& =long, var% =entier, var$ alphanum
'test si c'est une feuil "KM 0000"
If Left(LCase(ActiveSheet.Name), 2) <> "km" Then MsgBox "Cette feuille n'est pas une Feuille Kilometrage !": Exit Sub
'------------------------------------------
Dim Message As String
Dim NoColAdres%, NoColDesNoms%, NoPremColMois%, NoPremLig%, NoDernLig&, MoisEnCours%
NoColAdres = 1 'Col(A)
NoColDesNoms = 2 'Col(B)
NoPremColMois = 5 'Col(E)
NoPremLig = 11 ' 1'lig du tableau
NoDernLig = Range("A" & Rows.Count).End(xlUp).Row
'mois en cours
MoisEnCours = Month(Date)
NoColMoisEnCours = NoPremColMois + MoisEnCours - 1
Moi$ = Cells(NoPremLig - 1, NoColMoisEnCours)
'si ligne inférieure tableau, exit
If NoDernLig < NoPremLig Then MsgBox "Aucune donnée en cours !?": Exit Sub
'boucle sur le tableau
For I = NoPremLig To NoDernLig
Nom$ = Cells(I, NoColDesNoms) 'nom
Adres$ = Cells(I, NoColAdres) 'adres
M$ = Cells(I, NoColMoisEnCours) 'contenu lig/col du mois
'si mois en cours vide envoi mail
If M$ = "" Then
Message = "Le fichier à compléter pour le mois " & Moi$ & " est le suivant: " & vbLf & _
ThisWorkbook.Path & "\" & ThisWorkbook.Name & vbLf & vbLf & _
"<p>Merci par avance.</p>"
'MsgBox Message
EnvoyerEmail Nom$, Adres$, Message
End If
Next
End Sub
Sub EnvoyerEmail(ByVal NomContact As String, ByVal Destinataire As String, ByVal Message As String)
'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'On déclare les variables
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim strRelance As String
'On ouvre un nouvel email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'On indique le corps du mail avec du HTML
strbody = "<HTML><BODY><H4>Bonjour " & NomContact & ",</H4><p>L'échéance arrivant à termes, merci de remplir le document approprié par la suite.</p>" & _
Message
'Si erreur pas au code suivant
On Error Resume Next
'Ce code permet l'ajout de la signature dans le corps du texte
With OutMail
.Importance = 2
.Display 'Affiche la fenêtre du mail | Obligatoire pour ajouter la signature, à masquer si pas nécessaire
.To = Destinataire 'Le ou les destinataire(s) du mail
.CC = "" 'La ou les personne(s) en copie du mail
.Subject = "Rappel échéance kilométrage véhicule" 'L'objet du mail
.HTMLBody = strbody & .HTMLBody 'Le corps du mail + signature
.ReadReceiptRequested = True
' .Send 'Envoie du mail automatique
End With
Application.DisplayAlerts = True
On Error GoTo 0
'on vide les variables objet
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
En vous remerciant par avance et bonne journée
Bien à vous.
