Hyper Link

[hemant86]

Hi All,

I am using Lotus Notes 8.5.2
I'm trying convert a text in my body to hyperlink through VBA.
And also when am trying to save the email as draft its asking to select a classificatio(Internal/Restricted/Highly Restricted), save not able to save it.

How can I achive the above to.Below is the code I'm using.
=========================================
Option Explicit

'Function for finding the first top level window in the windows list
'that meet the criteria.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Sub Send_Formatted_Range_Data()
Dim oWorkSpace As Object, oUIDoc As Object
Dim rnBody As Range
Dim lnRetVal As Long


Const stTo As String = "Excel@Microsoft.com"
Const stCC As String = "Lotus Notes@IBM.com"
Const stBody As String = vbCrLf & "Dear Invoice Recipient," & vbCrLf _
& "" & vbCrLf & "We hereby enclose May-16 Recharge Invoice (or Credit note) for your settlement. For additional Invoice details please refer to the SharePoint," & vbCrLf & _
"" & vbCrLf & "Request you to arrange settlement as soon as possible with the method stated on the Invoice." & vbCrLf & "" & vbCrLf & ""

Const st1Body As String = vbCrLf & "Note:" & vbCrLf _
& "Should you have any queries, please raise on our SharePoint under 'Queries & Adhocs' tab." & vbCrLf & _
"" & vbCrLf & "Kindly let us know if you are not the intended recipient of this email, please let us know immediately." & vbCrLf & "" & vbCrLf & ""

Const stSubject As String = "Invoice Reference"
Const stMsg As String = "An e-mail has been succesfully created and saved."

'Check if Lotus Notes is open or not.
lnRetVal = FindWindow("NOTES", vbNullString)

If lnRetVal = 0 Then
MsgBox "Please make sure that Lotus Notes is open!", vbExclamation
Exit Sub
End If

Application.ScreenUpdating = False

Workbooks.Open Filename:="C:\Users\43888280\Downloads\HBME Invoices April Final FCD-Algeria.xlsx"
Sheets("Summary View").Select
Range("D1:K1").Select
Selection.EntireColumn.Hidden = True
'A named range in the activesheet is in use.
Set rnBody = ActiveSheet.Range("B2:L22")
rnBody.Copy

'Instantiate the Lotus Notes COM's objects.
Set oWorkSpace = CreateObject("Notes.NotesUIWorkspace")

On Error Resume Next
Set oUIDoc = oWorkSpace.ComposeDocument("", "", "Memo")
On Error GoTo 0

Set oUIDoc = oWorkSpace.CurrentDocument

'Using LotusScript to create the e-mail.
Call oUIDoc.FieldSetText("EnterSendTo", stTo)
Call oUIDoc.FieldSetText("EnterCopyTo", stCC)
Call oUIDoc.FieldSetText("Subject", stSubject)

'If You experience any issues with the above three lines then replace it with:
'Call oUIDoc.FieldAppendText("EnterSendTo", stTo)
'Call oUIDoc.FieldAppendText("EnterCopyTo", stCC)

'Call oUIDoc.FieldAppendText("Subject", stSubject)

'The can be used if You want to add a message into the created document.
' Call oUIDoc.FieldSetText("Body", vbNewLine & stBody)

'Here the selected range is pasted into the body of the outgoing e-mail.
Call oUIDoc.GoToField("Body")
Call oUIDoc.InsertText("Body", vbNewLine & st1Body)
Call oUIDoc.GoToField("Body")
Call oUIDoc.Paste
Call oUIDoc.GoToField("Body")
Call oUIDoc.InsertText("Body", vbNewLine & stBody)



'Save the created document.

Call oUIDoc.Save(False, True) ', False)
'If the e-mail also should be sent then add the following line.
'Call oUIDoc.Send(True)

'Release objects from memory.
Set oWorkSpace = Nothing
Set oUIDoc = Nothing

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

MsgBox stMsg, vbInformation

'Activate Lotus Notes.
AppActivate ("Notes")

End Sub
======================================

Thanks in Advance