Insert text from cell within Hyperlink in a email using VBA

Question

Insert text from cell within Hyperlink in a email using VBA

Anonymous

Hello,

I am fairly new to VBA and I am trying to understand how it really works.

So currently I have an excel sheet with items that have due dates.I was able to look online and send out emails to certain people with their respective due dates. Each email has a link to the excel file thats on a network drive.

However, now I am required to link to somewhere else where each item has a folder. The trick to this is that there is a directory where each item is placed in this directory. They are all within in 1 folder. The folders have the same name as in the text in the excel sheet.

I was wondering if there is a way to take the text from the cell respective to each item and place it in the hyperlink? So depending on the item and when its due. The hyperlink will change every time so it goes to the specific folder. Here is the example of the structure. Y:\Main Directory\Folder 1 and another one would be Y:\Main Directory\Folder 3. I placed the name of each folder next to each item within the excel sheet. Also the column with the name of each folder is in column "B". How would I go about this? Thank you! Much appreciated!

Here is the code I have so far:

appreciated!

Here is the code:

 Option Explicit

    Public Sub CheckAndSendMail()
     Dim lRow As Long
     Dim lstRow As Long
     Dim toDate As Date
     Dim toList As String
     Dim ccList As String
     Dim bccList As String
     Dim eSubject As String
     Dim EBody As String
     Dim vbCrLf As String

     Dim ws As Worksheet

     With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .DisplayAlerts = True

     End With

     Set ws = Sheets(1)
     ws.Select

     lstRow = WorksheetFunction.Max(3, ws.Cells(Rows.Count, "R").End(xlUp).Row)

     For lRow = 3 To lstRow

     toDate = CDate(Cells(lRow, "R").Value)

     If Left(Cells(lRow, "R"), 4) <> "Mail" And toDate - Date <= 7 Then
     vbCrLf = "<br><br>"

     toList = Cells(lRow, "F") 'gets the recipient from col F
     eSubject = "Text " & Cells(lRow, "C") & " is due on " & Cells(lRow, "R").Value
        EBody = "<HTML><BODY>"
        EBody = EBody & "Dear " & Cells(lRow, "F").Value & vbCrLf
        EBody = EBody & "Text" & Cells(lRow, "C") & vbCrLf
        EBody = EBody & "Text" & vbCrLf
        EBody = EBody & "Link to the Document:"
        EBody = EBody & "<A href='Hyperlink to Document'>Description of Document </A>" & vbCrLf
        'Line below is where the hyperlink to the folder directory and the different folder names
        EBody = EBody & "Text" & "<A href= 'Link to folder Directory\Variable based on                text'>Description </A>"
        EBody = EBody & "</BODY></HTML>"

     MailData msgSubject:=eSubject, msgBody:=EBody, Sendto:=toList

     'Cells(lRow, "W").Value = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column W"

     End If
     Next lRow

     ActiveWorkbook.Save

     With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .DisplayAlerts = True

     End With

     End Sub

     Function MailData(msgSubject As String, msgBody As String, Sendto As String, _
     Optional CCto As String, Optional BCCto As String, Optional fAttach As String)

     Dim app As Object, Itm As Variant
     Set app = CreateObject("Outlook.Application")
     Set Itm = app.CreateItem(0)
     With Itm
     .Subject = msgSubject
     .To = Sendto
     If Not IsMissing(CCto) Then .Cc = CCto
     If Len(Trim(BCCto)) > 0 Then
     .Bcc = BCCto
     End If
     .HTMLBody = msgBody
     .BodyFormat = 2 '1=Plain text, 2=HTML 3=RichText -- ISSUE: this does not keep HTML formatting -- converts all text
     'On Error Resume Next
     If Len(Trim(fAttach)) > 0 Then .Attachments.Add (fAttach) ' Must be complete path'and filename if you require an attachment to be included
     'Err.Clear
     'On Error GoTo 0
     .Save ' This property is used when you want to saves mail to the Concept folder
     .Display ' This property is used when you want to display before sending
     '.Send ' This property is used if you want to send without verification
     End With
     Set app = Nothing
     Set Itm = Nothing
     End Function

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

1 answer

Answer 1

Anonymous

This was resolved.

I used the following code:

"<A href=" & chr(34) & "J:\Main Directory\" & Range("B" & lRow).Value & chr(34) & ">Description of Document </A>"

0 comments

Share via

Insert text from cell within Hyperlink in a email using VBA

1 answer