Hyperlien dans Body du email
Bonjour le Forum,
besoin de votre aide s il vous plait . j ai un tableau Excel contenant dans la colonne G plusieurs Hyperliens que je veux envoyer a plusieurs collegues Via le Outlook .le probleme est que je n arrive plus a faire un click sur ses Hyperliens une fois dans le Outlook. j ai passe une journee a checher une solution jusqu ici je n ai toujours rien. Merci d avance. voici le code
Dim OutApp As Object
Dim OutMail As Object
Dim Antwort As Integer
Dim WB1 As Workbook
Dim VAName As Integer
Dim VANum As Integer
Dim VABearb As Integer
Dim WS As Worksheet
Dim TempFileName As String
Dim i
Dim vOrname As String
Dim intLeerPos As Integer
Dim Laenge As Integer
Dim Name As String
Dim AnzahlZeichen As Integer
Dim wer As String
Dim body As String
Dim hyper As String
Sheets("Uebersichtsliste").Visible = True
Set WB1 = ActiveWorkbook
ActiveCell.Select
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
Name = ActiveCell(1, 18)
intLeerPos = InStr(Name, " ")
Laenge = Len(ActiveCell(1, 18))
AnzahlZeichen = Laenge - intLeerPos
'vOrname = Right(Name, AnzahlZeichen)
vOrname = Left(Name, AnzahlZeichen)
.To = ActiveCell(1, 18)
.CC = ""
.BCC = ""
.Subject = ActiveCell(1, 7) & " " & " " & ActiveCell(1, 8)
'.GetInspector
'body = " <a href=""" & ActiveCell(1, 7) & """ >Hier</a>"
.htmlbody = "<html><body>Hallo Herr/Frau" & vOrname & "," & "<br><br> <p>" & _
"<html><body> anbei sende ich Ihnen die geänderte/ neue Zentralanweisung" & "<a href= """ & ActiveCell(1, 7).Value & """ > Hier </a>" & "mit der Bitte um Prüfung und Beantwortung in den vorbereiteten Feldern." & "<html><body><html><body>" & _
"<html><body>Aus unserer Kenntnis der EhP Abläufe und Zuständigkeiten glauben wir, dass Du der richtige Ansprechpartner bist, der die untenstehenden Entscheidungen treffen kann:" & "<br><br> <p>" & _
"<html><body>Ist die mitgeteilte Änderung grundsätzlich relevant für EhP, Ja/nein?" & _
"<html><body><B>Wenn ja:</B>" & "<br>" & _
"<html><body> a) Warum: Welche Auswirkung hat die Änderung auf die EhP- Prozesse?" & " <p>" & _
"<html><body> b) Welche EhP-Prozess- oder Methodenbeschreibung muss angepasst werden?" & "<p>" & _
"<html><body> c) Wer übernimmt die Anpassung der EhP-Prozess- oder Methodenbeschreibung ?" & "<p>" & _
"<html><body>Bitte informiere Sie mit der Rückmeldung den Verantwortlichen zu dieser Aufgabe." & "<p>" & _
"<html><body> d) Wer muss außer dem betroffenen PO bzw. MO noch zu der geänderten Vorgabe informiert werden?" & "<br><br>" & _
"<html><body>Die Umsetzung der zentralen Vorgaben muss bis zum:" & " " & Date - 15 & " " & "abgeschlossen sein." & "<br><br>" & _
"<html><body><B>Wenn nein:</B>" & "<br>" & _
"Bitte ich Sie um Ihre Rückmeldung, um den Vorgang mit Ihrer Entscheidung abschließen zu können." & "<br><br><pr>" & _
"<html><body>Für den Fall Sie sind nicht der richtige Ansprechpartner oder Du kannst diese Bewertung nicht selbst vornehmen," & "<br>" & "bitte ich Sie zeitnah, die Nachricht an den aus Ihrer Sicht verantwortlichen Bereich zu senden." & "<br>" & "Außerdem bitte ich Sie, mich in allen genannten Fällen darüber in Kenntnis zu setzen." & "<br><br>" & _
"<html><body>Vielen Dank im Voraus." & .htmlbody & "<br><br> " & _
"<html><body>Mit freundlichen Grüßen / Best regards" & "<br><br> <p>" & _
"<html><body>Prozessauditor / FMEA Moderation / Lenkung Dokumente (PS/QMM7-EhP)" & "<br>" & _
.Reminder = Date & "12:21"
.Display
ActiveCell(1, 15) = Date
ActiveCell(1, 19) = Date - 15
ActiveCell(1, 12) = Application.UserName
'ActiveCell(1, 7).Hyperlinks(1).Address.Value = hyper
Set OutApp = CreateObject("Outlook.Application")
wer = OutApp.GetNamespace("MAPI").CurrentUser
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Sheets("Uebersichtsliste").Visible = True
End Sub
bonjour,
vérifie que tu as bien sélectionné la bonne cellule avant de lancer ta macro.
la cellule sélectionnée devrait être 6 colonnes avant celle contenant l'adresse du lien.
Bonjour H2So4,
la cellule est bien selectioné je l ai essayer plusieurs fois. ca copie uniquement le nom de l hyperlien
Bonjour,
pas de problème chez moi. Peut-être y a-t-il une option activée en outlook pour rendre les liens inactifs ?
Bonjour,
ca je ne sais pas je vais faire une recherche j espere pouvoir trouve quelque chose.
Un grand merci pour ton interet
Bonjour,
pour mes tests, le contenu de la cellule est une url. Si ce n'est pas le cas, il faut alors utiliser
& "<a href= """ & ActiveCell(1, 7).Hyperlinks(1).Address & """ > Hier </a>bonjour,
waoo un grand merci a toi ca fonctionne comme je veux