XL 2019 Lien Cliquable VBA Email

LuanaDDC

XLDnaute Junior
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...

1605692625598.png


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.
 

Pièces jointes

  • 1605692576014.png
    1605692576014.png
    31.2 KB · Affichages: 39
Solution
Re...

VB:
        .Subject = "Rappel échéance kilométrage véhicule" 'L'objet du mail
        .HTMLBody = strbody & .HTMLBody 'Le corps du mail + signature

'Essaye 1 ==> Si par exemple l'adresse de ton fichier est dans la cellule A1
       .Attachments.Add ActiveSheet.Range("A1").Value

'Essaye 2 ==> adresse en dur de ton fichier
       .Attachments= "C:\Monchemin\Surmondisquedur\montruc\monmachin.xlsm"

'Essaye 3 ==> 'MonFichier est déclaré avec son chemin un peu plus haut
       .Attachments.Add (MonFichier)

'......... le reste de ton code

@Phil69970

LuanaDDC

XLDnaute Junior
Par contre j'ai deux petites questions :

J'ai voulu tester l'exemple 1 et l'exemple 2 :

Concernant l'exemple 1 : dans ma cellule j'ai fait "Insérer" -> "Lien" -> j'ai sélectionné mon fichier Excel. Lorsque je lance la macro, je sélectionne mon fichier mais lorsque je reçois par mail je n'ai pas de pièce joint. Par contre, le fichier s'ouvre automatiquement et la macro se relance (donc je dois sélectionner mon fichier et envoyer le mail) et ce à l'infini ahah. Peut-être qu'il faut j'enlève : MonFichier$ = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")

Concernant l'exemple 2, c'est pareil je n'ai pas la pièce joint qui s'affiche. Est-il possible que ce soit parce que mon fichier est sur un serveur interne ? Sachant que tout le monde à accès à au serveur.

Merci !!
 

Phil69970

XLDnaute Barbatruc
LuanaDDC, Roland, le forum

Pour éviter l'ouverture de la boite de dialogue
MonFichier=ThisWorkbook.Path & "\" & ThisWorkbook.Name
(peut être il faudra remplacer ThisWorkbook.Name par ThisWorkbook.FullName )

L’accès au serveur devrait se faire comme cela : "\\.......\.........\......."

Dans l'essai 1 ==> Dans la cellule A1 de mon exemple tu dois avoir le chemin complet du fichier
exemple : C:\Monchemin\Surmondisquedur\montruc\monmachin.xlsm
Si chemin réseau ==> \\Monchemin\MonRepServeur\Montruc\Monmachin.xlsm

Dans l'essai 2 ==>Pour un chemin reseau
.Attachments= "\\Monchemin\MonRepServeur\Montruc\Monmachin.xlsm"

Dans l'essai 3 ==> MonFichier=ThisWorkbook.Path & "\" & ThisWorkbook.Name
(peut être il faudra remplacer ThisWorkbook.Name par ThisWorkbook.FullName )
donc ==> .Attachments.Add (MonFichier)

@Phil69970
 

LuanaDDC

XLDnaute Junior
Merci pour ta réponse Phil ! Mais ça ne marche pas...

Quand je fais tes exemples je n'ai pas de pièce joint.

J'ai laissé ce qui était au début et j'ai ça qui apparaît lorsque je clique sur mon lien.

Mon chemin réseau de présente comme cela : Z:\05 - Matériel agence\Véhicules\kilometrage.xlsm

Est ce que je dois mettre : Z:\\05...... ou directement \\05...... ?

J'essaye de voir d'une autre façon.

Merci !!

1605780738067.png
 

Pièces jointes

  • kilometragesVLR(test).xlsm
    46.8 KB · Affichages: 2

Phil69970

XLDnaute Barbatruc
LuanaDDC, Roland, le forum

Qu'est ce qui ne marche pas l'essai 1, 2 ou 3
Autrement essaye avec le Z:\\...
Mais à mon avis il faut que tout le monde est accès au serveur ET avec la même arborescence.

Si une des solutions fonctionne gardent là ...

Autrement fait un essai avec le fichier sur c:\ pour voir si le principe fonctionne bien...
Si c'est bon ==> Va du plus simple et avance vers le plus compliqué ....
Cherche des liens sur google pour retrouvé un chemin réseau etc ...
Je n'ai pas de serveur donc je te guide complétement à l'aveugle ....

@Phil69970
 

LuanaDDC

XLDnaute Junior
Phil66970,

Merci pour ta réponse.

Effectivement tout le monde a accès au serveur et à l'arborescence.. Je ne comprends pas le message d'Outlook..
La solution de mettre le fichier en attachement marche en mettant les Z:\\ sauf que c'est en lecture seule donc la personne doit enregistrer le fichier à chaque fois.

Le fait de les rediriger directement à l'emplacement du fichier afin qu'ils remplissent 1 seul et même fichier est ce qu'il y a de mieux.

Je vais essayer de voir ce qu'il ne va pas.. Je ne peux pas le mettre sur le C: car je ne suis pas admin ^^.

Merci beaucoup pour ton aide en tout cas.
 

Discussions similaires

Statistiques des forums

Discussions
311 707
Messages
2 081 746
Membres
101 812
dernier inscrit
trufu