VBA - Email Based on cell data

[lpratt]

I am looking for a VBA that will:

Send a email with the link to where the workbook is saved

Sent to the email address that is in Q4

The subject line from J11

The body of the text from R4


thank you

 

[JerrExcel]

Hi @lpratt ,

From my previous work, the way I make this work is as below: (Note: I am using Outlook as my primary emailing tools as VBA can control Outlook from excel)

1. Having multiple files (person1.xlsx, person2.xlsx, person3.xlsx....etc) in a folder, where each file contains the same format of Email address: Q4, subject: J11, body: R4.
2. Create a macro template - with macro working as below:
   • Open developer tools - References - look for "Microsoft Outlook Object Library", tick & click OK.
   • Start the macro by using Msgbox to remind user open Outlook app
   • Open FileDialog to prompt user to select the file (go to the folder which contain files)
   • User selected file and defined as variable "mypath"
   • Open file
   • Create Outlook email new item, insert details from opened file. (getting Q4, J11, R4)
   • Close file
   • Msgbox "Email has been sent to: emailaddress"
   • Clean up variables explicitly before ending sub
3. Create a button to run this macro.

Refer my VBA code below:

Sub SendEmail()
If MsgBox("Note01: Have you opened Outlook app?", vbYesNo) = vbNo Then Exit Sub

Dim OutlookApp As Object
Dim OutlookMailItem As Object
Dim strEmail As String

Dim wbkS As Workbook
Dim wshS As Worksheet
    
Dim FilePicker As fileDialog
Dim mypath As String
    
Set FilePicker = Application.fileDialog(msoFileDialogFilePicker)
    
    With FilePicker
        .Title = "Please Choose One"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
        .ButtonName = "Confirm"
            If .Show = -1 Then
                mypath = .SelectedItems(1)
                Else
                    End
            End If
    End With
'On Error Resume Next
Set wbkS = Workbooks.Open(mypath)
Set wshS = wbkS.Worksheets(1)

Set OutlookApp = CreateObject("Outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)

With OutlookMailItem
    strEmail = wshS.Range("Q4").Value
    .To = strEmail
    .Subject = wshS.Range("J11").Value
    .Body = wshS.Range("R4").Value
    .send
End With

wbkS.Close

MsgBox "Email has been sent to: " & strEmail

Set OutlookMailItem = Nothing
Set OutlookApp = Nothing
Set FilePicker = Nothing
Set wbkS = Nothing
Set wshS = Nothing

End Sub

Feel free to try it out.
Peace out

 

[lpratt]

can this be changed so that there is no pop-up box asking if the Outlook app is opened? to just clicking the button and Outlook opens a new message with the recipient, subject, and body completed? that way if additional information is required it can be entered then?

 

[JerrExcel]

Yes, you can just comment out the code for pop-up. (Just make sure you open the outlook app readily at the back before running this macro)

Like so:

Sub SendEmail()
'If MsgBox("Note01: Have you opened Outlook app?", vbYesNo) = vbNo Then Exit Sub

Dim OutlookApp As Object
Dim OutlookMailItem As Object
Dim strEmail As String

Dim wbkS As Workbook
Dim wshS As Worksheet
    
Dim FilePicker As fileDialog
Dim mypath As String
    
Set FilePicker = Application.fileDialog(msoFileDialogFilePicker)
    
    With FilePicker
        .Title = "Please Choose One"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
        .ButtonName = "Confirm"
            If .Show = -1 Then
                mypath = .SelectedItems(1)
                Else
                    End
            End If
    End With
'On Error Resume Next
Set wbkS = Workbooks.Open(mypath)
Set wshS = wbkS.Worksheets(1)

Set OutlookApp = CreateObject("Outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)

With OutlookMailItem
    strEmail = wshS.Range("Q4").Value
    .To = strEmail
    .Subject = wshS.Range("J11").Value
    .Body = wshS.Range("R4").Value
    .send
End With

wbkS.Close

MsgBox "Email has been sent to: " & strEmail

Set OutlookMailItem = Nothing
Set OutlookApp = Nothing
Set FilePicker = Nothing
Set wbkS = Nothing
Set wshS = Nothing

End Sub

 

[Trevor G]

Within the code provided by JerrExcel change the

.Send to .Display then you can visually see the email and edit it if needed before you click send.