Solved

Email Option On Ranges

Posted on 2014-02-12
5
306 Views
Last Modified: 2014-02-17
From the below code, I want to send this message if instersect range is F2:F26 (general course categories)

Msg = "Please visit the following link to view information and register for the course you requested: " & "%0D%0A" & "%0D%0A" & Range("$L" & Right(Target.Address, 2)).Value & "%0D%0A" & "%0D%0A"  & " If we can be of further assistance, please contact us." & " Thank you."

I want to send this message if instersect range is F7 (with an option to only send the above code - this range (F7) will include a specific course and can include a course book but want to give the user an option to not include the course book link if student doesn't need or has course book):

  Msg = "Please visit the following link to view information and register for the course you requested: " & "%0D%0A" & "%0D%0A" & Range("$L" & Right(Target.Address, 2)).Value & "%0D%0A" & "%0D%0A" _
    & "Your course books can be viewed here: " & "%0D%0A" & "%0D%0A" & Range("$M" & Right(Target.Address, 2)).Value & "%0D%0A" & "%0D%0A" & " If we can be of further assistance, please contact us." & " Thank you."



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim lngResponse As Long
    Dim URL As String, Email As String, Subj As String, body As String, Msg As String
    
      If Intersect(Target, Range("F2:F27")) Is Nothing Then
      
      
    Exit Sub
 Else

   
 Email = Range("$E" & Right(Target.Address, 2)).Value
 
  TheDate = Format(Date, "Long Date")
    TheTime = Format(Time, "Medium Time")

' Determine greeting based on time
    Select Case Time
        Case Is < 0.5:     Greeting = "Good Morning"
        Case Is >= 0.7083: Greeting = "Good Evening"
        Case Else:         Greeting = "Good Afternoon"
    End Select

 body = Greeting

   
    
      
            lngResponse = MsgBox("You are about to send an email with a link to course information. Would you like to continue?", vbYesNo)
            If lngResponse = vbYes Then
           
   
     'Replace spaces with %20 (hex)
  
    Subj = "Course Information for " & Range("$D" & Right(Target.Address, 2)).Value
    
     Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
      Msg = "Please visit the following link to view information and register for the course you requested: " & "%0D%0A" & "%0D%0A" & Range("$L" & Right(Target.Address, 2)).Value & "%0D%0A" & "%0D%0A" _
       & "Your course books can be viewed here: " & "%0D%0A" & "%0D%0A" & Range("$M" & Right(Target.Address, 2)).Value & "%0D%0A" & "%0D%0A" & " If we can be of further assistance, please contact us." & " Thank you."
     Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
     
        
    'Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
     
     
    'Create the URL
     URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & body & "," & "%0D%0A" & "%0D%0A" & Msg & "%0D%0A" & "%0D%0A"
     
    'Execute the URL (start the email client)
     ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
            
                  End If
        End If
   
End Sub

Open in new window

0
Comment
Question by:tracyms
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 19

Expert Comment

by:regmigrant
ID: 39858294
would you post a sample workbook and explain what is not working?
0
 
LVL 1

Author Comment

by:tracyms
ID: 39859179
The code I posted is working, I just want to make the changes to it that I requested in my question.
0
 
LVL 10

Accepted Solution

by:
broro183 earned 500 total points
ID: 39860770
hi Tracyms,

Does the below code do what you want?
If it doesn't, a sample workbook would be very helpful. For example, we could see if there is actually a column which identifies if the user has/needs the workbook. If one exists, then there would be no need to ask for more user input into the macro.


I've left a few bits of code in there which are commented out. They may help you see how I broke up your code. I have just concatenated/replaced the msg string using "msg = msg &...", but you could change your code to have different variables which may make the code clearer, for example "StartOfMsg", "CourseBookLink" & "EndOfMsg".

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lngResponse As Long
Dim URL As String, Email As String, Subj As String, body As String, Msg As String
Dim TheDate As String
Dim TheTime As String
Dim Greeting As String
Dim TrgtRow As Long

    'RB, Q: should the range extend to row 27 (as below) or to row 26 as stated in the question?
    If Intersect(Target, Range("F2:F27")) Is Nothing Then
        Exit Sub
    Else

        TrgtRow = Target.Row
        Email = Range("$E$" & TrgtRow).Value
        TheDate = Format(Date, "Long Date")
        TheTime = Format(Time, "Medium Time")

        ' Determine greeting based on time
        Select Case Time
            Case Is < 0.5: Greeting = "Good Morning"
            Case Is >= 0.7083: Greeting = "Good Evening"
            Case Else: Greeting = "Good Afternoon"
        End Select

        lngResponse = MsgBox("You are about to send an email with a link to course information. Would you like to continue?", vbYesNo)
        If lngResponse = vbYes Then
            'Replace spaces with %20 (hex)
            Subj = "Course Information for " & Range("$D$" & TrgtRow).Value
            Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")

            'in EE Q, if F2:F26 (general course categories)
            Msg = "Please visit the following link to view information and register for the course you requested: " _
                  & "%0D%0A" & "%0D%0A" & Range("$L$" & TrgtRow).Value
            '& "%0D%0A" _
             & "%0D%0A" & " If we can be of further assistance, please contact us." & " Thank you."

            If Target.Address = "$F$7" Then
                ''in EE Q, if instersect range is F7 (with an option to only send the above code - this range (F7) _
                 ''will include a specific course and can include a course book but want to give the user an option _
                 ''to not include the course book link if student doesn't need or has course book):
                'Msg = "Please visit the following link to view information and register for the course you requested: " _
                 & "%0D%0A" & "%0D%0A" & Range("$L$" & TrgtRow).Value
                lngResponse = MsgBox("Do you want to include the course book link?", vbYesNo)
                If lngResponse = vbYes Then
                    Msg = Msg & "%0D%0A" & "%0D%0A" & "Your course books can be viewed here: " _
                          & "%0D%0A" & "%0D%0A" & Range("$M$" & TrgtRow).Value
                    '& "%0D%0A" & "%0D%0A" & " If we can be of further assistance, please contact us." & " Thank you."
                End If
            End If
            Msg = Msg & "%0D%0A" & "%0D%0A" & " If we can be of further assistance, please contact us." & " Thank you."

'            'in the original code:
'            Msg = "Please visit the following link to view information and register for the course you requested: " _
'                  & "%0D%0A" & "%0D%0A" & Range("$L$" & TrgtRow).Value & "%0D%0A" _
'                  & "%0D%0A" & "Your course books can be viewed here: " & "%0D%0A" & "%0D%0A" & Range("$M$" & TrgtRow).Value _
'                  & "%0D%0A" & "%0D%0A" & " If we can be of further assistance, please contact us." & " Thank you."
            Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
            'Replace carriage returns with %0D%0A (hex)
            Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

            'Create the URL
            URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Greeting & "," & "%0D%0A" & "%0D%0A" & Msg & "%0D%0A" & "%0D%0A"

            'Execute the URL (start the email client)
            ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
        End If
    End If

End Sub

Open in new window


hth
Rob
0
 
LVL 1

Author Comment

by:tracyms
ID: 39863393
Oops, I meant F27 instead of F7 but Rob your code is what I wanted. A27 is a data entry field in my workbook. I enter a specific (single) course number which may/may not include a course book for this specific course. The other fields (A2-A26) are course categories which you can browse courses of interest (A2=Music, A3=Computers, etc.).

I can send a student a link by double clicking in one of the fields on the same row (F2-F7), depending upon what they are looking for - a link to a specific course so they can register (this is F27) or a link to any of our course categories so they can browse or look through all our courses.  

Students often ask about books for a course so I wanted an option to include the book link along with the course - if they haven't purchased their course book already. Thanks.
0
 
LVL 10

Expert Comment

by:broro183
ID: 39864248
I'm pleased I could help. Thanks for the points :-)
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Starting up a Project

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question