Hallo Forum,
ik was op zoek naar een hyperlink en die te plaatsen in de "opslaan en verzend" code vanuit Excel,
Heb iets gevonden, maar weet niet precies waar te plaatsen in mijn code, is net weer iets anders
Onderstaande code geschreven door HSV in februari maar zegt deze te plaatsen voor send.
ik mijn code staat geen send. omdat het mogelijk moet zijn om nog tekst toe te voegen voor verzenden.
en denk dat deze enigszins aangepast moet worden, zie dat Wddoc. en address en subject anders zijn, .
nu wil ik de link het liefst gekoppeld hebben in de mailBody aan de lnk
of als mogelijk is rechtstreeks aan het document, zodat deze gelijk opent.
wie kan mij op weg helpen.
dit is mijn gehele code
ik was op zoek naar een hyperlink en die te plaatsen in de "opslaan en verzend" code vanuit Excel,
Heb iets gevonden, maar weet niet precies waar te plaatsen in mijn code, is net weer iets anders
Onderstaande code geschreven door HSV in februari maar zegt deze te plaatsen voor send.
ik mijn code staat geen send. omdat het mogelijk moet zijn om nog tekst toe te voegen voor verzenden.
en denk dat deze enigszins aangepast moet worden, zie dat Wddoc. en address en subject anders zijn, .
Code:
WdDoc.Hyperlinks(1).Address = "mailto:email@adres.nl?subject=Afmelden%20van%20mailinglist%20-%20" & Email
nu wil ik de link het liefst gekoppeld hebben in de mailBody aan de lnk
of als mogelijk is rechtstreeks aan het document, zodat deze gelijk opent.
wie kan mij op weg helpen.
dit is mijn gehele code
Code:
Sub mail_werkboek_met_sendmail_adressen()
Dim MailAddress As String
Dim MailSubject As String
Dim MailBody As String
Dim OutMail As Object
Dim OutApp As Object
Dim pad, lnk, naam As String
Dim thisWb As Workbook
'MyOldName = ActiveWorkbook.FullName
pad = "S:\Projecten\Klachten\Nieuwe Klachten procedure 2020\Klachten in behandeling"
lnk = "S:\Projecten\Klachten\Nieuwe Klachten procedure 2020\Klachten in behandeling"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
If ActiveWorkbook.Name = "Klachtenformulier 20201" Then
ActiveWorkbook.SaveAs pad & "\" & Sheets("Klachtenformulier").Range("F1") & ".xlsm", FileFormat:=52
Else
If ActiveWorkbook.Name = Sheets("Klachtenformulier").Range("F1") & ".xlsm" Then
ActiveWorkbook.Save
End If
End If
'Mail naar wie versturen
naam = ActiveWorkbook.Name
naam = Replace(naam, " ", "%20")
MailBody = "Er staat een klachtenformulier klaar" & ": in map: " & lnk
MailSubject = "Nieuwe klachtenformulier: " & Sheets("klachtenformulier").Range("F1")
MailAddress = Join(Array(Range("D29"), Range("E29"), Range("E30")), ";")
MailAddress = Replace(MailAddress, ";0", "")
With OutMail
.to = MailAddress
.CC = ""
.BCC = ""
.Subject = MailSubject
.Body = MailBody
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
ActiveWorkbook.Close (False)
End Sub