Sending an Email by referencing another sheet

ChaosPup

New Member
Joined
Sep 27, 2021
Messages
48
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I have the code below working to send an email from a workbook (ignore the garbage address obviously) -

VBA Code:
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Hello" & vbNewLine & vbNewLine & _
          "text1." & vbNewLine & vbNewLine & _
          "text2"

On Error Resume Next
With OutMail
    .To = "emailaddress@emailaddress.com"
    .CC = ""
    .BCC = ""
    .Subject = "Subject Line"
    .Body = strbody
    'You can add a file like this
    '.Attachments.Add ("C:\test.txt")
    .Send   'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

What I want to do instead of manually inserting an email address after .To is for the macro to look at the highlighted cell and reference it to the email address which will be listed in a separate sheet. For example, if sheet 1 has the initials AM in the highlighted cell, I want it to find the address on sheet 2 which matches the initials AM. Anyone have any ideas? Thanks!
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
You can use ActiveCell.Value to access it. But why do you want to have one sheet with initials and one sheet with email addresses? And how do you want the initials and addresses to be linked? For example, will the initials on row 27 correspond to the address on row 27?
 
Upvote 0
You can use ActiveCell.Value to access it. But why do you want to have one sheet with initials and one sheet with email addresses? And how do you want the initials and addresses to be linked? For example, will the initials on row 27 correspond to the address on row 27?
Fair point. So let's assume that the highlighted cell will always be in column A and the email address will be in column G. Could I use something like ActiveCell.Offset (0,6)? I'm not sure how I would work it into the code I already have? Thanks for replying!
 
Upvote 0
Fair point. So let's assume that the highlighted cell will always be in column A and the email address will be in column G. Could I use something like ActiveCell.Offset (0,6)? I'm not sure how I would work it into the code I already have? Thanks for replying!
Sorry, I'm talking rubbish. The initials will be selected from a dropdown, so the macro will have to select the email address from its location based on the dropdown selection.
 
Upvote 0
Alright, I see. To me using the initials sounds redundant though, and people can share initials. How would you know who you are sending it to? I would just have the email addresses directly, it skips a step.

If you have them in cells, you could do

VBA Code:
.To = ActiveCell.Value

If you have them in a drop down list, you do

VBA Code:
.To = Cell(1, "A").Value 'if the dropdown list is on A1
 
Upvote 0
Alright, I see. To me using the initials sounds redundant though, and people can share initials. How would you know who you are sending it to? I would just have the email addresses directly, it skips a step.

If you have them in cells, you could do

VBA Code:
.To = ActiveCell.Value

If you have them in a drop down list, you do

VBA Code:
.To = Cell(1, "A").Value 'if the dropdown list is on A1
Thanks again! So the sheet is basically a list of events, each event is assigned to a person and that persons initials are selected from a dropdown in column G. It's set up so no one has the same initials. The assigned persons initials could therefore be in G3, G4, G5....etc., and that's what's confusing me.
 
Upvote 0
Alright, thanks, with that piece of information I see why you want to keep the initials, should've told us that fro the beginning ;)

My suggestion: First sheet is where you have your events and initials dropdowns. The 2nd sheet looks like the image below, column A contains initials and column B contains the corresponding email. You fill these out manually.

1641888900964.png


These lines of code can then fetch the correct address for you, based on the active/selected cell in your first sheet.

VBA Code:
Sub emailFromInitials()

    Dim iniCell As Range
    Set iniCell = Worksheets(2).Range("A:A").Find(ActiveCell.Value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If iniCell Is Nothing Then
        MsgBox ("No cell is active")
    ElseIf iniCell.Value = vbNullString Then
        MsgBox ("Active cell is empty")
    
    Else
        emailValue = iniCell.Offset(0, 1)
        MsgBox (emailValue) 'replace your "emailaddress@emailaddress.com" with emailValue
    End If
    
End Sub

Let me know if you need any help implementing it in your existing code :)
 
Upvote 0
Improved version:

VBA Code:
Sub emailFromInitials()

    Dim emailValue As String
    Dim iniCell As Range
   
    If ActiveCell Is Nothing Then
        MsgBox ("No cell is active")
    ElseIf ActiveCell.Value = vbNullString Then
        MsgBox ("Active cell is empty")
    Else
        Set iniCell = Worksheets(2).Range("A:A").Find(ActiveCell.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If iniCell Is Nothing Then
                MsgBox ("Couldn't find a match")
            Else
                emailValue = iniCell.Offset(0, 1)
                MsgBox (emailValue) 'Do what you want to do with a matched email address here, instead of MsgBox
            End If
    End If

End Sub
 
Upvote 0
Improved version:

VBA Code:
Sub emailFromInitials()

    Dim emailValue As String
    Dim iniCell As Range
  
    If ActiveCell Is Nothing Then
        MsgBox ("No cell is active")
    ElseIf ActiveCell.Value = vbNullString Then
        MsgBox ("Active cell is empty")
    Else
        Set iniCell = Worksheets(2).Range("A:A").Find(ActiveCell.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If iniCell Is Nothing Then
                MsgBox ("Couldn't find a match")
            Else
                emailValue = iniCell.Offset(0, 1)
                MsgBox (emailValue) 'Do what you want to do with a matched email address here, instead of MsgBox
            End If
    End If

End Sub
Perfect thanks so much!
 
Upvote 0
Improved version:

VBA Code:
Sub emailFromInitials()

    Dim emailValue As String
    Dim iniCell As Range
  
    If ActiveCell Is Nothing Then
        MsgBox ("No cell is active")
    ElseIf ActiveCell.Value = vbNullString Then
        MsgBox ("Active cell is empty")
    Else
        Set iniCell = Worksheets(2).Range("A:A").Find(ActiveCell.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If iniCell Is Nothing Then
                MsgBox ("Couldn't find a match")
            Else
                emailValue = iniCell.Offset(0, 1)
                MsgBox (emailValue) 'Do what you want to do with a matched email address here, instead of MsgBox
            End If
    End If

End Sub

Perfect thanks so much!
This worked perfectly. The only other question I have is - one of the addresses it goes to will be fixed, the other will be defined by the code you gave me. Is it possible to send them both on the .To command? I tried it in various formats but couldn't get it to work. I was hoping to copy the email to more than 1 fixed address as well.
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,268
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top