Daheb
Daheb

Reputation: 35

Hyperlink or button to run macro with active cell offsets

I am looking for a way to easily send out emails. I have an excel file that I add about 20 rows to every day with a customer number and order number. Also an email address, different subjects and bodies depending on the country. I use Lotus Notes and have all the code set up to send out and attach a file. My Macro for sending emails uses offsets on the active cell. So currently, I am clicking on a certain cell and then pressing a keybind to send the email.

However, I want to change it so that people can click on a hyperlink or a button on each row to create the email. I tried it using buttons from the form and activex controls, but this made my file too slow.

I then looked into a way of activating a macro when you click on a hyperlink.

I found this on the internet.

    Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Select Case Target.Range.Address
    Case "$B$3"
    Call myMacro
    Case Else
    End Select
    End Sub

But this only works for the link in cell B3. How do I make it so that if I click any link in the B column, the macro will run?

Feel free to let me know if there are any other solutions too.

Kind regards,

Edit1:

this is the code for the email

Sub myMacro(Target As Range)
'Send an e-mail & attachment using Lotus Not(s)
'Original Code by Nate Oliver (NateO)
'Declare Variables for file and macro setup
Dim UserName As String, MailDbName As String, Recipient As String, ccRecipient As String, Attachment1 As String
Dim Maildb As Object, MailDoc As Object, AttachME As Object, Session As Object
Dim EmbedObj1 As Object
With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = _
Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Recipient = Target.Offset(0, 1).Value
MailDoc.SendTo = Recipient
ccRecipient = Target.Offset(0, 2).Value
MailDoc.CopyTo = ccRecipient
MailDoc.Subject = Target.Offset(0, 3).Value
MailDoc.Body = Target.Offset(0, 4).Value

Dim Orderno
Dim myPath
Dim myFile

Orderno = Target.Offset(0, 5).Value
myPath = ThisWorkbook.Path & "D:\Berry\Order Confirmations\VBAtest\"
myFile = Dir(myPath & "*" & Orderno & "*.pdf*")
Attachment1 = (myPath & myFile)
MsgBox (Attachment1)
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", (myPath & myFile), "")
On Error Resume Next
End If

Set workspace = CreateObject("Notes.NotesUIWorkspace")
Call workspace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

Upvotes: 0

Views: 791

Answers (1)

Xabier
Xabier

Reputation: 7735

To get the macro to run when anything on column B is clicked:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Select Case Target.Range.Column
    Case 2 'Two being the column number
        Call myMacro
    Case Else
End Select
End Sub

As you are using Offset to get the values for your emails, then you would offset the target to get the right values, so if you were to pass an argument ot yourmacro something like:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Select Case Target.Range.Column
    Case 2 'Two being the column number
        Call myMacro(Target.Range)
    Case Else
End Select
End Sub

Then in your macro you could do the following:

Sub myMacro(Target as Range)
    Target.offset(0,1).value 'to get the value to the right of the clicked cell    
.....

End sub

Upvotes: 2

Related Questions