Excel Email and Hyperlinks

[RhysPhelps]

Bonjour all, this is quickly becoming my most favourite website

I have *ahem* created *ahem* with copious amounts of help from websites through google a macro that generates emails from an excel sheet. My sheet contains hyperlinks to documents that when i run the macro (thus opening an email) are not copied into the email (i.e they are just whatever text happens to be in the sheet.) is it possible to copy over hyperlinks?

the macro i am using is below. no doubt the very helpful person who created this would recognise it and i am in no way claiming it is mine. if you do happen to read this my thanks go out to you, you incredibly helpful hero.

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Cells(ActiveCell.Row, 3)

Subj = Cells(ActiveCell.Row, 15)
Msg = ""
Msg = Msg & "Dear " & Cells(ActiveCell.Row, 3) & "," & vbCrLf & vbCrLf & "The termination notice date of the contract number below is only 1 month away. Please contact the Budget Holder to find out if a Renewal is required or, in the case of an automatic renewal, whether the contract should continue. If this contract has been mistakenly assigned please contact who will make the appropriate changes" & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 1) & vbCrLf & vbCrLf & "Many Thanks, Your friendly helpful excel sheet genie."

'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

'Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'Wait two seconds before sending keystrokes
'Application.Wait (Now + TimeValue("0:00:02"))
'Application.SendKeys "%s"
End Sub


The hyperlinks are contained in column A and refer to the bold part of the macro above

Thanks all

 

[RhysPhelps]

13 views and not an answer, take it it cannot be done then