Sending template email from a name in a listbox

[w1r3d]

Hi All,
I am a bit stuck with making my first VBA program.
The idea is to have a form with a Listbox containing names and once a name is selected and a button (called something like 'Send Email') is clicked the program will send a pre-saved email template to that person. The email address and body are all saved and ready to send in the template.
I have been able to send a template and create a Listbox but not the 2 together.
Any help is greatly appreciated, I would have loved to learn programming at school but I was born too soon.

Send Email script

'Attribute VB_Name = "Module1"
Sub SendBasicEmail()

Dim olApp As Outlook.Application
Dim olemail As Outlook.MailItem

Set olApp = New Outlook.Application
Set olemail = olApp.CreateItemFromTemplate("O:\MIS\ZIP Templates\TEST.msg")

olemail.Display

olemail.Send


End Sub

Create a Listbox

Private Sub UserForm_Initialize()
ListBox1.AddItem "TEST"
ListBox1.AddItem "MCA"
ListBox1.AddItem "MSC"
ListBox1.AddItem "MECS"
ListBox1.AddItem "CA"

End Sub

 

[w1r3d]

I have been working on the below but I am still stuck

'Attribute VB_Name = "Module1"
Sub SendBasicEmail()
    
    Dim olApp As Outlook.Application
    Dim olemail As Outlook.MailItem
    
    Set olApp = New Outlook.Application
    Set olemail = olApp.CreateItemFromTemplate("O:\MIS\ZIP Templates\TEST.msg")
    
    olemail.Display
    
    olemail.Send
   
    
End Sub




Private Sub UserForm_Initialize()

   'Creates and assigns the Array to the ListBox when the form loads.
   Dim mylist As Variant

   mylist = Array("TEST", "Monday", "Tuesday", "Wednesday", _
      "Thursday", "Friday", "Saturday")
   ListBox1.List = mylist

End Sub

Private Sub CommandButton1_Click()
   'First Method: Displays individual selections one at a time.
   For x = 0 To ListBox1.ListCount - 1

      If ListBox1.Selected(x) = True Then
         MsgBox ListBox1.List(x)
      End If

   Next x
   Unload Me

End Sub

 

[w1r3d]

So far I have the below

Private Sub UserForm_Initialize()

   'Creates and assigns the Array to the ListBox when the form loads.
   Dim mylist As Variant

   mylist = Array("AARDS", "NGAARDA", "LARRAKIA", _
      "2CUZ", "NG MEDIA", "PAKAM", "PAW MEDIA", "PY MEDIA", "QRAM", "TEABBA", "TSIMA", "6WR", "TEST")
   ListBox1.List = mylist

End Sub

Private Sub CommandButton1_Click()
   'First Method: Displays individual selections one at a time.
   For x = 0 To ListBox1.ListCount - 1

      If ListBox1.Selected(x) = True Then
         MsgBox ListBox1.List(x)
      End If

   Next x
   Unload Me

End Sub

 

[w1r3d]

The current code is below and it works great.
Any idea how I can run this from Outlook not Excel?

Private Sub UserForm_Initialize()

   'Creates and assigns the Array to the ListBox when the form loads.
   Dim mylist As Variant

   mylist = Array("TEST", "AARDS", "NGAARDA", "LARRAKIA", _
      "2CUZ", "NG MEDIA", "PAKAM", "PAW MEDIA", "PY MEDIA", "QRAM", "TEABBA", "6WR", "TSIMA")
   ListBox1.List = mylist

End Sub

Private Sub CommandButton1_Click()

    Dim olApp As Outlook.Application
    Dim olemail As Outlook.MailItem
    
    'TEST
        If ListBox1.Selected(0) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\0.TEST.msg")
    
            olemail.Send
        MsgBox ListBox1.List(0)
        End If
    'AARDS
        If ListBox1.Selected(1) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\1.AARDS.msg")
    
            olemail.Send
        MsgBox ListBox1.List(1)
        End If
    'NGAARDA
        If ListBox1.Selected(2) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\2.NGAARDA.msg")
    
            olemail.Send
        MsgBox ListBox1.List(2)
        End If
    'LARRAKIA
        If ListBox1.Selected(3) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\3.LARRAKIA.msg")
    
            olemail.Send
        MsgBox ListBox1.List(3)
        End If
    '2CUZ
        If ListBox1.Selected(4) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\4.2CUZ.msg")
    
            olemail.Send
        MsgBox ListBox1.List(4)
        End If
    'NG MEDIA
        If ListBox1.Selected(5) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\5.NG MEDIA.msg")
    
            olemail.Send
        MsgBox ListBox1.List(5)
        End If
    'PAKAM
        If ListBox1.Selected(6) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\6.PAKAM.msg")
    
            olemail.Send
        MsgBox ListBox1.List(6)
        End If
    'PAW MEDIA
        If ListBox1.Selected(7) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\7.PAW MEDIA.msg")
    
            olemail.Send
        MsgBox ListBox1.List(7)
        End If
    'PY MEDIA
        If ListBox1.Selected(8) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\8.PY MEDIA.msg")
    
            olemail.Send
        MsgBox ListBox1.List(8)
        End If
    'QRAM
        If ListBox1.Selected(9) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\9.QRAM.msg")
    
            olemail.Send
        MsgBox ListBox1.List(9)
        End If
    'TEABBA
        If ListBox1.Selected(10) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\10.TEABBA.msg")
    
            olemail.Send
        MsgBox ListBox1.List(10)
        End If

    ' 6WR
        If ListBox1.Selected(11) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\11.6WR.msg")
    
            olemail.Send
        MsgBox ListBox1.List(11)
        End If
        
    'TSIMA
        If ListBox1.Selected(12) = True Then
            Set olApp = New Outlook.Application
            Set olemail = olApp.CreateItemFromTemplate("O:\MIS\1 ZIP Templates\12.TSIMA.msg")
            
            olemail.Send
        MsgBox ListBox1.List(12)
        End If

        
End Sub

 

[w1r3d]

I have been trying to convert it to VBS but are finding it way harder than I thought.
Any help is greatly appreciated

 

[w1r3d]

so far I have the below but I cant get the listbox selection to trigger email templates. I have been able to run the script to create the listbox and I have been able to get VBS to send a email.
However not the 2 together and help is greatly appreciated

Option Explicit

Dim aItems, i

' Array containing items for ListBox
aItems = Array("TEST", "AARDS", "NGAARDA", "LARRAKIA", "2CUZ", "NG MEDIA", "PAKAM", "PAW", "PY MEDIA", "QRAM", "TEABBA", "6WR", "TSIMA")

' Create HTA window wrapper
With New clsSmallWrapperForm
    ' Setup window
    .ShowInTaskbar = "yes"
    .Title = "Test HTA UserForm"
    .Width = 354
    .Height = 118
    .Visible = False
    ' Create window
    .Create
    ' Assign handlers
    Set .Handlers = New clsSmallWrapperHandlers
    ' Add ListBox
    With .AddElement("ListBox1", "SELECT")
        .size = 6
        .multiple = True
        .style.left = "15px"
        .style.top = "10px"
        .style.width = "250px"
    End With
    .AppendTo "Form"
    ' Add ListBox items
    For i = 0 To UBound(aItems)
        .AddElement , "OPTION"
        .AddText aItems(i)
        .AppendTo "ListBox1"
    Next
    ' Add OK Button
    With .AddElement("Button1", "INPUT")
        .type = "button"
        .value = "OK"
        .style.left = "285px"
        .style.top = "10px"
        .style.width = "50px"
        .style.height = "20px"
    End With
    .AppendTo "Form"
    ' Add Cancel Button
    With .AddElement("Button2", "INPUT")
        .type = "button"
        .value = "Cancel"
        .style.left = "285px"
        .style.top = "40px"
        .style.width = "50px"
        .style.height = "20px"
    End With
    .AppendTo "Form"
    ' Add Label
    With .AddElement("Label1", "SPAN")
        .style.left = "15px"
        .style.top = "98px"
        .style.width = "350px"
    End With
    .AddText "Choose items"
    .AppendTo "Form"
    ' Show window
    .Visible = True
    ' Wait window closing or user choise
    Do While .ChkDoc And Not .Handlers.Selected
        WScript.Sleep 100
    Loop
    ' Read results from array .Handlers.SelectedItems
    If .Handlers.Selected Then
        MsgBox "Selected " & (UBound(.Handlers.SelectedItems) + 1) & " Item(s)" & vbCrLf & Join(.Handlers.SelectedItems, vbCrLf)
    Else
        MsgBox "Window closed"
    End If
    ' The rest part of code ...

End With

Class clsSmallWrapperHandlers

    ' Handlers class implements events processing
    ' Edit code to provide the necessary behavior
    ' Keep conventional VB handlers names: Public Sub <ElementID>_<EventName>()

    Public oswForm ' mandatory property

    Public Selected
    Public SelectedItems

    Private Sub Class_Initialize()
        Selected = False
        SelectedItems = Array()
    End Sub

    Public Sub ListBox1_Click()
        Dim vItem
        With CreateObject("Scripting.Dictionary")
            For Each vItem In oswForm.Window.ListBox1.childNodes
                If vItem.Selected Then .Item(vItem.innerText) = ""
            Next
            SelectedItems = .Keys()
        End With
        oswForm.Window.Label1.style.color = "buttontext"
        oswForm.Window.Label1.innerText = (UBound(SelectedItems) + 1) & " selected"
    End Sub

    Public Sub Button1_Click()
        Selected = UBound(SelectedItems) >= 0
        If Selected Then
            oswForm.Window.close
        Else
            oswForm.Window.Label1.style.color = "darkred"
            oswForm.Window.Label1.innerText = "Choose at least 1 item"
        End If
    End Sub

    Public Sub Button2_Click()
        oswForm.Window.close
    End Sub

End Class

Class clsSmallWrapperForm

    ' Utility class for HTA window functionality
    ' Do not modify

    ' HTA tag properties
    Public Border ' thick | dialog | none | thin
    Public BorderStyle ' normal | complex | raised | static | sunken
    Public Caption ' yes | no
    Public ContextMenu ' yes | no
    Public Icon ' path
    Public InnerBorder ' yes | no
    Public MinimizeButton ' yes | no
    Public MaximizeButton ' yes | no
    Public Scroll ' yes | no | auto
    Public Selection ' yes | no
    Public ShowInTaskbar ' yes | no
    Public SysMenu ' yes | no
    Public WindowState ' normal | minimize | maximize

    ' Form properties
    Public Title
    Public BackgroundImage
    Public Width
    Public Height
    Public Left
    Public Top
    Public Self

    Dim oWnd
    Dim oDoc
    Dim bVisible
    Dim oswHandlers
    Dim oLastCreated

    Private Sub Class_Initialize()
        Set Self = Me
        Set oswHandlers = Nothing
        Border = "thin"
        ContextMenu = "no"
        InnerBorder = "no"
        MaximizeButton = "no"
        Scroll = "no"
        Selection = "no"
    End Sub

    Private Sub Class_Terminate()
        On Error Resume Next
        oWnd.Close
    End Sub

    Public Sub Create()
        ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
        Dim sName, sAttrs, sSignature, oShellWnd, oProc
        sAttrs = ""
        For Each sName In Array("Border", "Caption", "ContextMenu", "MaximizeButton", "Scroll", "Selection", "ShowInTaskbar", "Icon", "InnerBorder", "BorderStyle", "SysMenu", "WindowState", "MinimizeButton")
            If Eval(sName) <> "" Then sAttrs = sAttrs & " " & sName & "=" & Eval(sName)
        Next
        If Len(sAttrs) >= 240 Then Err.Raise 450, "<HTA:APPLICATION" & sAttrs & " />"
        sSignature = Mid(Replace(CreateObject("Scriptlet.TypeLib").Guid, "-", ""), 2, 16)
        Set oProc = CreateObject("WScript.Shell").Exec("mshta ""about:<script>moveTo(-32000,-32000);document.title='*'</script><hta:application" & sAttrs & " /><object id='s' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>s.putProperty('" & sSignature & "',document.parentWindow);</script>""")
        Do
            If oProc.Status > 0 Then Err.Raise 507, "mshta.exe"
            For Each oShellWnd In CreateObject("Shell.Application").Windows
                On Error Resume Next
                Set oWnd = oShellWnd.GetProperty(sSignature)
                If Err.Number = 0 Then
                    On Error Goto 0
                    With oWnd
                        Set oDoc = .document
                        With .document
                            .open
                            .close
                            .title = Title
                            .getElementsByTagName("head")(0).appendChild .createElement("style")
                            .styleSheets(0).cssText = "* {font:8pt tahoma;position:absolute;}"
                            .getElementsByTagName("body")(0).id = "Form"
                        End With
                        .Form.style.background = "buttonface"
                        If BackgroundImage <> "" Then
                            .Form.style.backgroundRepeat = "no-repeat"
                            .Form.style.backgroundImage = "url(" & BackgroundImage & ")"
                        End If
                        If IsEmpty(Width) Then Width = .Form.offsetWidth
                        If IsEmpty(Height) Then Height = .Form.offsetHeight
                        .resizeTo .screen.availWidth, .screen.availHeight
                        .resizeTo Width + .screen.availWidth - .Form.offsetWidth, Height + .screen.availHeight - .Form.offsetHeight
                        If IsEmpty(Left) Then Left = CInt((.screen.availWidth - Width) / 2)
                        If IsEmpty(Top) Then Top = CInt((.screen.availHeight - Height) / 2)
                        bVisible = IsEmpty(bVisible) Or bVisible
                        Visible = bVisible
                        .execScript "var smallWrapperThunks = (function(){" &_
                            "var thunks,elements={};return {" &_
                                "parseHandlers:function(h){" &_
                                    "thunks=h;for(var key in thunks){var p=key.toLowerCase().split('_');if(p.length==2){elements[p[0]]=elements[p[0]]||{};elements[p[0]][p[1]]=key;}}}," &_
                                "forwardEvents:function(e){" &_
                                    "if(elements[e.id.toLowerCase()]){for(var key in e){if(key.search('on')==0){var q=elements[e.id.toLowerCase()][key.slice(2)];if(q){eval(e.id+'.'+key+'=function(){thunks.'+q+'()}')}}}}}}})()"
                        If Not oswHandlers Is Nothing Then
                            .smallWrapperThunks.parseHandlers oswHandlers
                            .smallWrapperThunks.forwardEvents .Form
                        End If
                    End With
                    Exit Sub
                End If
                On Error Goto 0
            Next
            WScript.Sleep 100
        Loop
    End Sub

    Public Property Get Handlers()
        Set Handlers = oswHandlers
    End Property

    Public Property Set Handlers(oHandlers)
        Dim oElement
        If Not oswHandlers Is Nothing Then Set oswHandlers.oswForm = Nothing
        Set oswHandlers = oHandlers
        Set oswHandlers.oswForm = Me
        If ChkDoc Then
            oWnd.smallWrapperThunks.parseHandlers oswHandlers
            For Each oElement In oDoc.all
                If oElement.id <> "" Then oWnd.smallWrapperThunks.forwardEvents oElement
            Next
        End If
    End Property

    Public Sub ForwardEvents(oElement)
        If ChkDoc Then oWnd.smallWrapperThunks.forwardEvents oElement
    End Sub

    Public Function AddElement(sId, sTagName)
        Set oLastCreated = oDoc.createElement(sTagName)
        If VarType(sId) <> vbError Then
            If Not(IsNull(sId) Or IsEmpty(sId)) Then oLastCreated.id = sId
        End If
        oLastCreated.style.position = "absolute"
        Set AddElement = oLastCreated
    End Function

    Public Function AppendTo(vNode)
        If Not IsObject(vNode) Then Set vNode = oDoc.getElementById(vNode)
        vNode.appendChild oLastCreated
        ForwardEvents oLastCreated
        Set AppendTo = oLastCreated
    End Function

    Public Function AddText(sText)
        oLastCreated.appendChild oDoc.createTextNode(sText)
    End Function

    Public Property Get Window()
        Set Window = oWnd
    End Property

    Public Property Get Document()
        Set Document = oDoc
    End Property

    Public Property Get Visible()
        Visible = bVisible
    End Property

    Public Property Let Visible(bWindowVisible)
        bVisible = bWindowVisible
        If ChkDoc Then
            If bVisible Then
                oWnd.moveTo Left, Top
            Else
                oWnd.moveTo -32000, -32000
            End If
        End If
    End Property

    Public Function ChkDoc()
        On Error Resume Next
        ChkDoc = CBool(TypeName(oDoc) = "HTMLDocument")
    End Function

End Class