Listbox to ask for files to attach

[josros]

I have this code for listbox, how can modify the code to ask for files to attach before opens outlook?

Code:

Option Explicit
'Populate a multi-column combo and list box with values from spreadsheet
'when the form is loaded
Private Sub UserForm_activate()
Dim MyList(47, 5) 'as array type
Dim R As Integer

'The list box contains 3 data columns.
'You can configure the number of columns, their width and height below
'as well as change the text in the ControlTipText of the listbox
Application.ShowToolTips = True
With ListBox1
.ColumnCount = 5
.ColumnWidths = 80
'.Width = 230
'.Height = 110
.ControlTipText = "Click the Name, Job, or ID you're after"
End With
'Define the list and where it's obtained from (Columns A, D, G in this example)
With ActiveSheet
'MyList (Row{0 to 9}, Column{0 to 2}) = the ranges given
For R = 0 To 47
MyList(R, 0) = .Range("A" & R + 1)
MyList(R, 1) = .Range("b" & R + 1)
MyList(R, 2) = .Range("c" & R + 1)
MyList(R, 3) = .Range("d" & R + 1)
MyList(R, 4) = .Range("e" & R + 1)
Next R
End With
'populate the list box
ListBox1.List = MyList
End Sub
'When a name in the listbox is clicked, select the corresponding row
Private Sub listBox1_Click()
Dim Employee As Variant
Dim Name As String
Dim firstaddress As String

Employee = Empty
'If you add more than 500 names you will need to increase this
With ActiveSheet.Range("a2:e500")
Name = ListBox1.Value
Set Employee = .Find(what:=Name, LookIn:=xlValues)
If Not Employee Is Nothing Then Employee.Rows.EntireRow.Select Else Exit Sub
End With
'closes the form when you click on a name
' Unload Me
Dim ce As Range, i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Dim wksht As Worksheet
Dim rw As Integer

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

Set wksht = Worksheets("Data")
rw = ActiveCell.Row

strto = wksht.Cells(rw, "b").Value
strcc = "" '.Cells(i, 4).Value
strbcc = ""
strsub = "Transaction ID: " & wksht.Cells(rw, "e").Value
strbody = "Hi" & _
vbCrLf & vbCrLf & "Thank you."
'End With

With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
'.Send
.display

End With

Set OutMail = Nothing
Set OutApp = Nothing
Set Employee = Nothing

With UserForm1
Unload Me
End With
[a1].Select
End Sub

[zbor]

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)