Inclure un lien HTLM vers un dossier dans un e-mail
Bonjour,
J'ai voulu créer une Macro à partir d'un tableau excel aujourd'hui alors que je n'y connais absolument rien.
Le but de cette macro était que lorsque l'on enregistre le fichier excel, dès qu'un utilisateur modifie le tableau, un mail est envoyé à tous les utilisateurs pour les avertir d'une modification, et mettre dans le corps de cette e-mail, un lien redirigeant vers le fichier.
J'ai mis ce code dans "ThisWorkBook":
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strbody As String
Dim ol As Object, monmail As Object
DisplayAlerts = False
Set ol = CreateObject("outlook.application")
Set monmail = ol.CreateItem(olMailItem)
monmail.T0 = "utilisateur1@gmail; utilisateur2@gmail; utilisateur3@gmail"
monmail.Subject = "Modifications"
monmail.HTMLBody = "Bonjour, merci de prendre connaissance des modifications effectuées" & "<a href=""C:\Dossier\Fichier.xlm\""> ici</a>" & " Merci"
monmail.Send
Set ol = Nothing
End SubLe problème c'est que dans mon e-mail, je n'ai aucun lien hypertexte redirigeant vers le fichier. Est-ce que quelqu'un saurait m'aider si je ne suis pas trop loin du but?
Par ailleurs, j'en profite, est-ce qu'il serait possible d'afficher dans le mail le tableau du fichier? j'ai trouvé cette ligne de code sur un autre forum mais comment l'ajouter à mes lignes de codes précédentes? (J'ai copié/collé tel quel le code ci-dessous donc je ne l'ai pas encore adapté à mon cas: texte à rajouter et cellule à modifier).
With oBjMail
.Display
'.To = " ***********@gmail" ' le destinataire
.Subject = Range("A1") & " - modification("E1") & "TR" & Range("E2")
.HTMLBody = "<html><body>" & "Madame, Monsieur," & _
"<br>" & "" & "</ br>" & _
"<br>" & "texte à ajouter" & Range("E1") & "er" & " texte à ajouter" & Range("E2") & "." & "</ br>" & _
"<br>" & "" & "</ br>" & _
"<br>" & "texte " & Range("E23").Text & ". " & "</ br>" & _
"<br>" & "" & "</ br>" & _
"<table border = 1>" & "<tr>" & "<td colspan = 2>" & Range("A25") & "</td>" & " </tr>" & _
"<tr>" & "<td>" & Range("A26") & "</td>" & "<td>" & Range("D26").Text & "</td>" & " </tr>" & _
"<tr>" & "<td>" & Range("A27") & "</td>" & "<td>" & Range("D27").Text & "</td>" & " </tr>" & _
"<tr>" & "<td>" & Range("A28") & "</td>" & "<td>" & Range("D28").Text & "</td>" & " </tr>" & _
"<tr>" & "<td>" & Range("A29") & "</td>" & "<td>" & Range("D29") & "</td>" & " </tr>" & _
"<tr>" & "<td>" & Range("A30") & "</td>" & "<td>" & Range("D30") & "</td>" & " </tr>" & _
"<tr>" & "<td>" & Range("A31") & "</td>" & "<td>" & Range("D31") & "</td>" & " </tr>" & "</table>" & _
"<br>" & "texte." & "</ br>" & _
"<br>" & "" & "</ br>" & _
"<br>" & "Cordialement," & "</ br>" & _
"</body></html>" & .HTMLBody
'.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
'.GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
'.Display ' Ici on peut supprimer pour l'envoyer sans vérification
'.Send
End WithMerci d'avance,
Newbiedu62
Bonjour,
regarde l'exemple ici :
Bbonjour,
j'ai réussi à inclure le lien HTLM grâce à votre aide.
Maintenant je voudrais inclure le tableau qui va de la colonne A1 à B13 dans l'envoi du mail. Comment et où le rajouter dans la ligne de code ci-dessous:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody, EmailAddr, EmailAddrCC, Subj As String
EmailAddr = Sheets("Feuil1").Range("H8")
EmailAddrCC = Sheets("Feuil1").Range("H9")
Subj = Sheets("Feuil1").Range("H11")
Sheets("Feuil1").Select
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Bonjour,<br><br>" & _
"Merci de consulter :<br><B>" & _
ActiveWorkbook.Name & "</B>qui a été modifié.<br>" & _
"Cliquez sur ce lien pour ouvrir le fichier : " & _
"<A HREF=""file://..." & _
""">nom du fichier</A>" & _
"<br><br>Cordialement</font>"
On Error Resume Next
With OutMail
.To = EmailAddr
.CC = EmailAddrCC
.BCC = ""
.Subject = Subj
.HTMLBody = strbody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End SubMaintenant je voudrais inclure le tableau qui va de la colonne A1 à B13 dans l'envoi du mail. Comment et où le rajouter dans la
en pièce jointe ou dans le corps du message ?
Dans le corps du message
re,
voici un exemple
Sub test()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody, EmailAddr, EmailAddrCC, Subj As String
EmailAddr = Sheets("Feuil1").Range("H8")
EmailAddrCC = Sheets("Feuil1").Range("H9")
Subj = Sheets("Feuil1").Range("H11")
Sheets("Feuil1").Select
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbodyT = tableauhtml(Range("A1:B13"))
strbody = "<font size=""3"" face=""Calibri"">" & _
"Bonjour,<br><br>" & _
"Merci de consulter :<br><B>" & strbodyT & _
ActiveWorkbook.Name & "</B>qui a été modifié.<br>" & _
"Cliquez sur ce lien pour ouvrir le fichier : " & _
"<A HREF=""file://..." & _
""">nom du fichier</A>" & _
"<br><br>Cordialement</font>"
On Error Resume Next
With OutMail
.To = EmailAddr
.CC = EmailAddrCC
.BCC = ""
.Subject = Subj
.HTMLBody = strbody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub
Function tableauhtml(Plage As Range) As String
Dim cel As Range
Set cel = Plage.Cells(1, 1)
tableauhtml = "<table>"
For i = 1 To Plage.Rows.Count
tableauhtml = tableauhtml & "<tr>"
For j = 1 To Plage.Columns.Count
tableauhtml = tableauhtml & "<td>" & texthtml(cel.Offset(i - 1, j - 1).Value) & "</td>"
Next
tableauhtml = tableauhtml & "</tr>"
Next
tableauhtml = tableauhtml & "</table>"
End Function
Function texthtml(texte As String)
texthtml = ""
For i = 1 To Len(texte)
Select Case Asc(Mid(texte, i, 1))
Case Is = 10
texthtml = texthtml & "<br/>"
Case Is = 39
texthtml = texthtml & "&#" & Application.Trim(Str(Asc(Mid(texte, i, 1)))) & ";"
Case Is > 127
texthtml = texthtml & "&#" & Application.Trim(Str(Asc(Mid(texte, i, 1)))) & ";"
Case Else
texthtml = texthtml & Mid(texte, i, 1)
End Select
Next
End FunctionBonjour, merci beaucoup pour votre réponse.
Par contre, cela ne fonctionne pas chez moi. Je n'ai pas d'erreur dans la macro mais le tableau ne s'affiche pas dans le corps du mail.
En fait, avec ma macro initial, lorsqu'un utilisateur enregistre le fichier, une fenêtre outlook s'ouvre et un e-mail pré-rédigée s'écrit.
Cela fonctionne bien, mais je souhaiterais aussi inclure dans le corps du message le tableau Excel. Après je pense aussi que ma Macro n'est pas très propre car j'ai pris des morceaux à droite et à gauche et j'ai tout mis dans la fenêtre "ThisWorkbook", donc c'est peut-être ça qui bug aussi.
Merci pour votre aide en tout cas,
Bonne journée