Multiple Input Boxes to Create Different Emails - vba

Question

Here is what I have been given to try and create:
User creates an email a few times per week and has to re-type everything, a request for employee updates, with up to 5 people on it. Easy enough to create in VBA, except that the employees could change each time. So there could be just 1 person, or 2, or 3, etc...and each time it could be a different mix of the employees. They want input boxes that would prompt how many employees for the email, then based on that input, follow-up boxes (if more than 1) that allow the input of the names (1 per box). It then needs to create the email, placing the input box data into the body text. Each email text will be based on the input from the 1st input box, so it can adjust for the number of employees (so there could be up to 5 employees on each email).
How do I assign values to my variables (findstrs and foundcells)so that they will adjust to the inputs of the inputboxes without writing all the IF stmts?
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim strbox As String
Dim stritem As String
Dim X As Long
Dim r As Long
Dim LR, lookrng As Range
Dim findStr As String
Dim nameCol As Range
Dim nameCol1 As Range
Dim nameCol2 As Range
Dim nameCol3 As Range
Dim nameCol4 As Range
Dim foundCell As Variant
Dim foundCell1 As Variant
Dim foundcell2 As Variant
Dim strname As String
Dim strBody As String
Dim sigString As String
Dim signature As String
Dim findstr1 As String
Dim foundrng As Range
Dim valuefound As Boolean
Dim strFilename As String
Select Case Application.ActiveWindow.Class
Case olInspector
Set oMail = ActiveInspector.CurrentItem
Case olExplorer
Set oMail = ActiveExplorer.Selection.Item(1)
End Select
If Dir(sigString) <> "" Then
signature = GetBoiler(sigString)
Else
signature = ""
End If
Set oReply = oMail.ReplyAll
Select Case Application.ActiveWindow.Class
Case olInspector
Set oMail = ActiveInspector.CurrentItem
Case olExplorer
Set oMail = ActiveExplorer.Selection.Item(1)
End Select
Set aOutlook = CreateObject("Outlook.Application")
Set oReply = aOutlook.CreateItem(0)
'Input box(es)
findStr = InputBox("Enter Number of Employees")
findstr1 = InputBox("Enter Name of First Employee")
If findStr = "2" Then findstr2 = InputBox("Enter Name of Second Employee")
If findstr1 = "T1" Then foundCell1 = "<B>Test 1 ID#0000</B>"
If findstr1 = "T2" Then foundcell2 = "<B>Test 2 IDO#0001</B>"
If findstr1 = "T3" Then foundcell3 = "<B>Test 3 ID#0002</B>"
If findstr1 = "T4" Then foundCell4 = "<B>Test 4 ID#0003</B>"
If findstr1 = "T5" Then foundCell5 = "<B>Test 5 ID#0004</B>"
If findstr2 = "T1" Then foundCell1 = "<B>Test 1 ID#0000</B>"
If findstr2 = "T2" Then foundcell2 = "<B>Test 2 IDO#0001</B>"
If findstr2 = "T3" Then foundcell3 = "<B>Test 3 ID#0002</B>"
If findstr2 = "T4" Then foundCell4 = "<B>Test 4 ID#0003</B>"
If findstr2 = "T5" Then foundCell5 = "<B>Test 5 ID#0004</B>"
'Greeting based on time of day
Select Case Time
Case 0.25 To 0.5
GreetTime = "Good morning"
Case 0.5 To 0.71
GreetTime = "Good afternoon"
Case Else
GreetTime = "Good evening"
End Select
sigString = Environ("appdata") & _
"\Microsoft\Signatures\Update.htm"
If Dir(sigString) <> "" Then
signature = GetBoiler(sigString)
Else
signature = ""
End If
If findStr = "1" Then
strBody = "<Font Face=calibri>Can you please update the following: <br><br>" & _
"<B>" & foundCell1 & "</B><br><br>" & _
"Please update this batch. " & _
"I Appreciate your help. Let me know if you need anything.<br><br>" & _
"Thanks <br><br>" & _
subject = "Employee Update"
ElseIf findStr = "2" Then
strBody = "<Font Face=calibri>Can you please add changes for the following: " & _
"<ol><li><B>" & foundCell1 & "</B><br><br><br><br>" & _
"<li><B>" & foundcell2 & "</B><br><br>" & _
subject = "Multiple Employee Requests"
End If
'Sets up the email itself and then displays for review before sending
With oReply
.HTMLBody = "<Font Face=calibri>Hi there,<br><br>" & strBody & signature
.To = "superman#krypton.com"
.CC = "trobbins#shawshank.com "
.subject = "Multiple Employee Updates"
.Importance = 2
.Display
End With
End Sub

Answer 1

You need to break this code down into multiple, smaller and parameterized scopes.
Make a Function that returns the body of the email given a Collection of batch numbers.
Private Function GetEmailBody(ByVal batchNumbers As Collection) As String
Now, the calling code needs to know how many employees there are. Make a function for that.
Private Function GetNumberOfEmployees() As Long
Dim rawInput As Variant
rawInput = InputBox("Number of employees?")
If StrPtr(rawInput) = 0 Then
'user cancelled out of the prompt
GetNumberOfEmployees = -1
Exit Function
Else If IsNumeric(rawInput) Then
GetNumberOfEmployees = CLng(rawInput)
End If
End Function
That'll return -1 if user cancels the prompt, 0 for an invalid input, and the number of employees otherwise.
Dim employeeName As String
Dim nbEmployees As Long
nbEmployees = GetNumberOfEmployees
If nbEmployees = -1 Then
Exit Sub 'bail out
Else If nbEmployees = 0 Then
'reprompt?
Exit Sub 'bail out, cancelled
End If
'fun part here
Dim emailbody As String
emailBody = GetEmailBody(batchNumbers, employeeName)
And now the fun part: you need to add as many items to some batchNumbers collection, as you have nbEmployees. Because you know how many iterations you'll need before you start looping, a For loop will do.
Dim batchNumbers As Collection
Set batchNumbers = New Collection
Dim batchNumber As String
Dim i As Long
For i = 1 To nbEmployees
batchNumber = GetBatchNumber(i)
If batchNumber = vbNullString Then Exit Sub 'bail out:cancelled/invalid
batchNumbers.Add batchNumber
Next
Dim body As String
body = GetEmailBody(batchNumbers)
Where GetBatchNumber(i) is yet another function call, to a function whose role it is to prompt for an employee number and lookup & return the corresponding batch number, returning an empty string if prompt is cancelled or no match is found.
Private Function GetBatchNumber(ByVal index As Long) As String
Dim rawInput As Variant
rawInput = InputBox("Name of employe " & index & ":")
If StrPtr(rawInput) = 0 Then
'cancelled
Exit Function
Else
Dim employeeName as String
employeeName = CStr(rawInput)
GetBatchNumber = GetBatchForEmployee(employeeName)
End If
End Function
If the mappings really actually look like T1 -> <B>Test 1 ID#000</B> then you can probably use this:
Private Function GetBatchForEmployee(ByVal employeeName As String)
Dim digit As Long
digit = CLng(Right$(employeeName, 1))
GetBatchForEmployee = "<B>Test " & digit & " ID#" & Format$(digit - 1, "000") & "</B>"
End Function
If your mappings are actual mappings then you can have a Dictionary lookup in here, or look them up on an Excel worksheet, a CSV or XML data file, a SQL Server database, whatever.
But first, break things down. A procedure that starts like this:
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim strbox As String
Dim stritem As String
Dim X As Long
Dim r As Long
Dim LR, lookrng As Range
Dim findStr As String
Dim nameCol As Range
Dim nameCol1 As Range
Dim nameCol2 As Range
Dim nameCol3 As Range
Dim nameCol4 As Range
Dim foundCell As Variant
Dim foundCell1 As Variant
Dim foundcell2 As Variant
Dim strname As String
Dim strBody As String
Dim sigString As String
Dim signature As String
Dim findstr1 As String
Dim foundrng As Range
Dim valuefound As Boolean
Dim strFilename As String
...is a procedure that's doing way too many things.