How do I create a custom pick list in VB for an outlook automated email?

Gary Lewis

New Member
Outlook version
Outlook 2016 64 bit
Email Account
POP3
I have a case where the "distribution" will not change very much, and would have multiple choices. The code below is what I have so far, it appears to be working for the most part, but the only value that populates to my .TO is the values in strP0list no matter what I pick from the combobox
Sub OutageNotification()
'-----------------------------------------
'DECLARE AND SET VARIABLES
Dim myOutlok As Object
Dim myMailItm As Object
Dim Signature As String
Dim strUsrPmt1 As String
Dim strDistroList As String
Set otlApp = CreateObject("Outlook.Application")
Set OtlNewMail = otlApp.CreateItem(olMailItem)
Dim message, title, defaultValue As String
message = "Enter your issue"
title = "Subject InputBox"
defaultValue = "No Issue"
strUsrPmt1 = InputBox(message, title, defaultValue, 25, 45)

strP0list = "List1-1@somewhere.com;List1-2@somewhere.com"
strP1list = "List2-1@somewhere.com;List2-2@somewhere.com"
strP2list = "List3-1@somewhere.com;List3-2@somewhere.com"
strP3list = "List4-1@somewhere.com;List4-2@somewhere.com"
'-----------------------------------------
'Get Distribution List
UserForm1.Show
Select Case lstNum
Case -1
' -1 is what you want to use if nothing is selected
strDistroList = "Please enter a valid email"
Case 0
strDistroList = strP0list
Case 1
strDistroList = strP1list
Case 2
strDistroList = strP2list
Case 3
strDistroList = strP3list
End Select
'-----------------------------------------
'GET DEFAULT EMAIL SIGNATURE
'Signature = Environ("appdata") & "\Microsoft\Signatures\"
' If Dir(Signature, vbDirectory) <> vbNullString Then
' Signature = Signature & Dir$(Signature & "*.htm")
' Else:
' Signature = ""
' End If
' Signature = CreateObject("Scripting.FileSystemObject").GetFile (Signature).OpenAsTextStream(1, -2).ReadAll
'-----------------------------------------
'CREATE EMAIL
OtlNewMail.HTMLBody = Signature
With OtlNewMail
.To = strDistroList
.CC = "someone@somewhere.com"
.Subject = "Notification: " & strUsrPmt1
.HTMLBody = "<p><font face=""Calibri"" size=""3"">" & "<B>" & "Team-" & "<BR>" & "<BR>" & "</B>" & "<I>" & "This is an important notice about ……(Describe the impacted technology)" _
& "<BR>" & "<BR>" & "</I>" & "<B>" & "What's happening?" & "</B>" & "<BR>" & "<BR>" & "<I>" & _
"In order to continue to reduce our …… (Describe the issue or effort)" & "</I>" & "<BR>" & "<BR>" & "<B>" & "What's the impact?" & "</B>" & "<BR>" & "<BR>" _
& "<I>" & "Beginning at 8 PM EST on Friday, December 9, network and phone connectivity will be .... (Describe the impact)" & _
"</I>" & "<BR>" & "<BR>" & "<B>" & "What's not impacted?" & "</B>" & "<BR>" & "<BR>" & "<I>" & "This does not impact remote.... (Describe what is not impacted)" _
& "</I>" & "<BR>" & "<BR>" & "<B>" & "Questions?" & "</B>" & "<BR>" & "<BR>" & "<I>" & "Contact me directly for questions or concerns." & "</I>" & "<BR>" & "<BR>" & Signature
.Display
'.Send
End With

'-----------------------------------------
'CLEANUP
Set OtlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
Set otlMess = Nothing
Set otlNSpace = Nothing
'-----------------------------------------
End Sub
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "Distribution1"
.AddItem "Distribution2"
.AddItem "Distribution3"
.AddItem "Distribution4"
End With
End Sub
Private Sub btnOK_Click()
lstNum = ComboBox1.ListIndex
Unload Me
End Sub
Can anybody offer some assistance with this? I am an old guy trying new things, and pretty much looking for any assistance, would someone be so kind as to review and show me the error of my ways?
 
Top