Reputation: 35
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
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