Links do not work once sent via outlook

Hi all,

Am using ronebruin mail VBA to send mails from outlook http://www.rondebruin.nl/mail/folder3/mail4.htm However the links do not appear to work.

If a cell has a hyperlink such as www.google.co.uk then it appears but it is no active. The links work in excel but just not when sent via outlook. any ideas???

Thanks in advance

Which set of code are you actually using?

could you post a sample file with a range reflecting your real file, ie that contains links which are failing to generate correctly in OL ?

is OL displaying the messages in plain text ?

Originally Posted by royUK

Which set of code are you actually using?

Roy, other than the notes (binding etc) all the code is required - the 2nd section is a Function for converting the Range

The code is as per the link but attached below.

As for the links it is every hyperlink in the excel file, so if i create a hyperlink in a cell it works in excel but once it has been outputted by the code it is no longer a hyper link. I am assuming that it may be something with the rangeto html function but from looking at it basically saves it as a web page and publish's it

Sub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)
        .Send   'or use .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

I'm running 2007 presently but I could only replicate the lack of link issue if I set OL to display the message in Plain text format... I will try and test on a pre 2007 environment later (unless someone else chooses to in the meantime...)

My out look is set to rich text

Am using OL 2003 XL 2003

OL mail format is set to Rich text no links working
OL mail format set to HTML no links working
OL mail format to plain text no links working

If i copy and paste manually into ol links work.

I am assuming that it is the rangetohtml function at first i though it was the because the HTMLtype was set to xlHtmlstatic but there is no other selction unless you wantinteractivity which means activex which i cannot use due to restrictions. Am I there for correct to assume that if my network security setting prohibit activex then an alternative solution needs to be sourced?

Ok after a looking at the function it is the following code snip that is causing the hyperlinks to be lost

    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select

As the function uses pastes special to paster the values.
In my spreadsheet people use the insert>hyperlink for the hyperlinks.
What would i need to change? My mind has drew a blank
It's prob the following line which needs changing just to astright forward

activecells.paste

hi i got this working now. Brain working slow

i changed the following

Cells(1).PasteSpecial xlPasteValues, , False, False

To

Cells(1).PasteSpecial xlPasteAll, , False, False

Sometimes we over look the small things and think its something alot bigger then what it actually is. If you have been working on this thanks for your time