I want create a hyper link in the VBA mail and should CONTAIN THE SUBJECT LINE WHEN THE HYPER LINK IN CLICKED

[santhosh]

HI Folks,

I am using the current code for the auto mailer through VBA.

A small glitch here I would like to add a hyperlink for the word Click Here (Hyperlink to {email address removed by Moderator})when I click that Click Here an Outlook has to open with the sub: Pass word reset

Currently I am using this code please make changes to this code and help to attain this task. This is an amazing forum

Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range



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

Set sh = Sheets("Sheet1")

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

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the file names in the C:D column in each row
Set rng = sh.Cells(cell.Row, 1).Range("")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = cell.Value
.Subject = "Migration to new Macro"

.body = "Dear All," & vbNewLine & vbNewLine & _
"Enclosed below is the weekly receipts for the previous week ( Last Monday to Till Date)" & vbNewLine & _
" If you find any discrepancies in the deliveries or if you feel that you have shipped and not booked in at , Kindly supplement us the Tracking No's or the POD to help us facilitate the booking with the " & vbNewLine & _
"Disclaimer: This is an auto generated mail carries the standard template. Kindly get in touch with the Genpact point of contact if you have any queries on the shipment and if you find a blank spreadsheet and you are guaranteed that you have made the shipment during the week, Kindly supply us the tracking details/ Proof of delivery to assist you better in this regard" & vbNewLine & _
"Click here"




For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing

With Application
.EnableEvents = True
.ScreenUpdating = True

End With
End Sub

 

[santhosh]

This is to VoG

I am using the current code for the auto mailer through VBA.

A small glitch here I would like to add a hyperlink for the word Click Here (Hyperlink to {email address removed by Moderator})when I click that Click Here an Outlook has to open with the sub: Pass word reset

Currently I am using this code please make changes to this code and help to attain this task. This is an amazing forum

Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range



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

Set sh = Sheets("Sheet1")

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

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the file names in the C:D column in each row
Set rng = sh.Cells(cell.Row, 1).Range("")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = cell.Value
.Subject = "Migration to new Macro"

.body = "Dear All," & vbNewLine & vbNewLine & _
"Enclosed below is the weekly receipts for the previous week ( Last Monday to Till Date)" & vbNewLine & _
" If you find any discrepancies in the deliveries or if you feel that you have shipped and not booked in at , Kindly supplement us the Tracking No's or the POD to help us facilitate the booking with the " & vbNewLine & _
"Disclaimer: This is an auto generated mail carries the standard template. Kindly get in touch with the Genpact point of contact if you have any queries on the shipment and if you find a blank spreadsheet and you are guaranteed that you have made the shipment during the week, Kindly supply us the tracking details/ Proof of delivery to assist you better in this regard" & vbNewLine & _
"Click here"




For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing

With Application
.EnableEvents = True
.ScreenUpdating = True

End With
End Sub[/QUOTE]