Choose email subject from dropdown list of excel column - vba

Question

I have code for emails and I want to connect to a column in an excel. When the macro is triggered, a dropdown should appear so I can choose to how to send the email depending on a list in an excel. The list is generated from other excels, it could have 2 full names or 40 full names. The list is in Sheet4 and the names are in column L, the email address is in column Q and the text in column P. If I choose from the dropdown, the name in L2, it should take the email address from Q2, the name from L2 and the text from P2. Here is what I have until now:
Sub email_to_one_person_from_the_list()
Dim OutApp As Object
Dim OutMail As Object
Dim xlApp As Object
Dim sourceWB As Object
Dim sourceWS As Object
Set xlApp = CreateObject("Excel.Application")
strFile = "C:\persons.xlsm"
Set sourceWB = xlApp.Workbooks.Open(strFile, , False, , , , , , , True)
Set sourceWH = sourceWB.Worksheets("Sheet4")
sourceWB.Activate
sourceWH.Application.Run "Module2.FetchData3"
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sourceWH.Range("Q2").Value
.CC = ""
.BCC = ""
.Subject = "Dear " & sourceWH.Range("L2").Value
.Display
OutMail.HTMLBody = sourceWH.Range("P2").Value
sourceWB.Close SaveChanges:=False
xlApp.Quit
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
and the combobox:
Private Sub CancelButton_Click()
Unload Me
End
End Sub
Private Sub OKButton_Click()
thelist1 = ComboBox1.ListIndex
Unload Me
End Sub
Private Sub UserForm_Initialize()
With ComboBox1
' the excel list here
End With
End Sub

Answer 1

edited after OP's usage of my original code and further clarifications
here follows a complete refactoring code as per the following "rules"
Option Explicitstatement
this forces you to declare all variables
but this little extra work but earns you back with much more control over what your writing and less debugging and/or maintenance efforts
main "mega" code splitting into many single Sub/Funcs
this helps in
have more readable and maintainable code
keeping Userforms and Applications loading and unloading calls away from any UserForm code, which must only take care of its real work: gather information
place this in your Outlook Module:
Option Explicit
Sub email_DP2()
Dim mailData As Variant
mailData = GetMailDataFromExcel("C:\persons.xlsm", _
"Module2.FetchData3", _
"Sheet4", _
"L")
If mailData = Empty Then Exit Sub
With CreateItem(0)
.SentOnBehalfOfName = ""
.Importance = olImportanceHigh
.To = mailData(1)
.Subject = mailData(0)
.GetInspector.WordEditor.Range.collapse 1
.Display
.HTMLBody = mailData(2)
'.Paste 'what are you pasting from?
End With
End Sub
'-------------------------------------------------------
' Excel handling Subs and Funcs
'-------------------------------------------
Function GetMailDataFromExcel(strFile As String, fetchingModule As String, strSheet As String, colStrng As String) As Variant
Dim xlApp As Excel.Application
Dim closeExcel As Boolean
Dim namesRng As Excel.Range
Set xlApp = GetExcel(closeExcel)
If Not xlApp Is Nothing Then
Set namesRng = GetExcelRange(xlApp, strFile, fetchingModule, strSheet, colStrng) 'this will get the names range from given column of given worksheet of given workbook
With UserForm14
If namesRng.Count = 1 Then
.ComboBox1.AddItem namesRng.Value
Else
.ComboBox1.List = xlApp.Transpose(namesRng)
End If
.Show
With .ComboBox1
If .ListIndex > -1 Then GetMailDataFromExcel = Array(.Value, _
namesRng.Offset(, 5).Cells(.ListIndex + 1, 1).Value, _
namesRng.Offset(, 6).Cells(.ListIndex + 1, 1).Value)
End With
End With
Unload UserForm14
Set namesRng = Nothing
ReleaseExcel xlApp, closeExcel
End If
End Function
Function GetExcelRange(xlApp As Excel.Application, strFile As String, fetchingModule As String, strSheet As String, colStrng As String) As Excel.Range
With xlApp.Workbooks.Open(strFile, , False, , , , , , , True)
xlApp.Run fetchingModule
With .Worksheets(strSheet)
Set GetExcelRange = .Columns(colStrng).Resize(.Cells(.Rows.Count, colStrng).End(xlUp).Row)
End With
End With
End Function
Function GetExcel(closeExcel As Boolean) As Excel.Application
On Error Resume Next
Set GetExcel = GetObject(, "Excel.Application")
If GetExcel Is Nothing Then
Set GetExcel = CreateObject("Excel.Application")
closeExcel = True
End If
If GetExcel Is Nothing Then
MsgBox "Couldn't instantiate Excel!", vbCritical
End If
End Function
Sub ReleaseExcel(xlApp As Excel.Application, closeExcel As Boolean)
If closeExcel Then xlApp.Quit
Set xlApp = Nothing
End Sub
'-------------------------------------------------------
place this in your UserForm14 code pane
Option Explicit
Private Sub btnOK_Click()
Me.Hide
End Sub
Private Sub CancelButton_Click()
Me.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
Me.Hide
End If
End Sub
in this latter I
added Option Explicit statement
although not strictly necessary (there is no variables usage but "built in" ones), it builds on a good habit
added a UserForm_QueryCloseevent handler
that handles the possible user's clicking the UserForm "Close" button
erased the End statement
I always learned it's a bad habit to use it and better stick to Exit Sub/Exit Function ones (possibly with proper mix of If.. Then.. Else blocks) to achieve the same effect without any harm

Answer 2

To connect your Outlook to Excel, you first have to add a reference to "Microsoft Excel XX Object Library" where XX is some version number (Extras->References)
Then create a userform, mine looks like this:
Note that my combobox has 2 columns (first one has a width of 0 so it's invisible)
Then, when you are loading the Form, add code to open an Excel instance and load the combobox with values to select from:
Private Sub UserForm_Initialize()
'Define Excel-Variables
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
'Create Excel Instance
Set xlApp = New Excel.Application
'Make it invisible
xlApp.Visible = False
'Open Workbook with Values
Set xlWB = xlApp.Workbooks.Open("PATH TO YOUR EXCEL FILE")
'Select the Sheet with Values
Set xlSheet = xlWB.Worksheets("sheet1")
Dim i As Integer
'Loop through the Values
For i = 1 To 30 Step 1
'This Combobox has 2 Columns where 1 is the bound one
'Add RowIndex to the first column(will be used to find the values later)
Me.cboTest.AddItem i
'Add the Name to the second Column
Me.cboTest.List(Me.cboTest.ListCount - 1, 1) = xlSheet.Cells(i, 1).Value
Next i
'Clean up and close Excel
Set xlSheet = Nothing
xlWB.Close False
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
Then you need to add some code to the button:
Private Sub cmdSend_Click()
'variables for the values we are getting now
Dim name As String, email As String, text As String
'more excel variables
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = New Excel.Application
xlApp.Visible = False
Set xlWB = xlApp.Workbooks.Open("PATH TO EXCEL FILE")
Set xlSheet = xlWB.Worksheets("sheet1")
'access the rowindex from the first column of the combobox
'use it for the Cells() as row
'column may be edited as needed
name = xlSheet.Cells(Me.cboTest.List(Me.cboTest.ListIndex, 0), 1).Value
email = xlSheet.Cells(Me.cboTest.List(Me.cboTest.ListIndex, 0), 2).Value
text = xlSheet.Cells(Me.cboTest.List(Me.cboTest.ListIndex, 0), 3).Value
'excel cleanup
Set xlSheet = Nothing
xlWB.Close False
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing
'print output to console
'instead of this, write your email
Debug.Print "mailto:" & email & " name:" & name & " text: " & text
End Sub
Then, if we open the form, we can select from the values:
If we then click the button, it will open excel and get the relevant values of the item we have selected.
Output for Name5 looks like this:
By the way, my excel example list looks like this:

Answer 3

#user3598756
I made the config with your code:
userform14 code:"
Private Sub btnOK_Click()
Me.Hide
End Sub
Private Sub CancelButton_Click()
Me.Hide
End
End Sub
Private Sub UserForm_Click()
End Sub
and the function code:
Sub email_DP2()
Dim name As String, email As String, text As String
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim oRng As Object
Dim StrBdB As String
Dim xlApp As Object
Dim sourceWB As Object
Dim sourceWS As Object
Set xlApp = CreateObject("Excel.Application")
strFile = "C:\persons.xlsm"
Set sourceWB = xlApp.Workbooks.Open(strFile, , False, , , , , , , True)
Set sourceWH = sourceWB.Worksheets("Sheet4")
sourceWH.Application.Run "Module2.FetchData3"
Dim pickedName As String, emailAddress As String, emailText As String
Dim namesRng As Range
With sourceWH '<== change "myWorkbookName" and "Sheet4" to your needs
Set namesRng = .Range("L1:L" & .Cells(.Rows.Count, "L").End(xlUp).Row)
End With
With UserForm14 ' change it to whatever name your actual UserForm has
.ComboBox1.List = xlApp.Transpose(namesRng)
.Show
With ComboBox1
pickedName = .Value
emailAddress = namesRng.Offset(, 5).Cells(.ListIndex + 1, 1).Value
emailText = namesRng.Offset(, 6).Cells(.ListIndex + 1, 1).Value
End With
End With
Unload UserForm14
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set OutMail = OutApp.CreateItem(0)
With OutMail
OutMail.SentOnBehalfOfName = ""
.Importance = olImportanceHigh
.To = emailAddress
.Subject = pickedName
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.collapse 1
.Display
OutMail.HTMLBody = emailText
oRng.Paste
End With
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub
It gives object required on line pickedName = .Value - if i eliminate the line it will give the same at line emailAddress = namesRng.Offset ... I thing is a problem with With ComboBox1 - if i eliminate with , it will generate an email but without the to, subject and text added to it.