Hi All:
I am managing a lead-generation tracker and everyday need to forward new leads pulled from Google to the 10-14 callers into an excel workbook. At the moment I am using the following code that splices the data into unique workbooks with caller names based upon the specific parsing column (24) selected through a dialog box.
My request for help pertains to the fact that i need to manually attach each file using Outlook and mail to the callers but need some help in automating the mailing process to the named callers. mail information can be added to column Y of the workbook if desired.
Code used currently is as follows-

Option Explicit

Sub ParseItems()

'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String

'Sheet with data in it
Set ws = Sheets("LEAD MASTER")

'Path to save files into, remember the final \
SvPath = "C:\LEADS\LEADS-"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
vTitles = "A1:X1"

'Choose column to evaluate from, column A = 1, B = 2, etc.
vCol = Application.InputBox("Select Column Number for Data Exraction" & vbLf _
& vbLf & "(Enter 24 for Parsing by Counselor Name)", "LEAD Parsing & Extraction", 1, Type:=1)
If vCol = 0 Then Exit Sub

'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Speed up macro execution
Application.ScreenUpdating = False

'Get a temporary list of unique values from column A
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

ws.Range("A1:A" & LR).EntireRow.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Cells.Columns.AutoFit
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, " DD-MM-YY") & ".xlsx", 51
ActiveWorkbook.Close False

ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm

'Cleanup
ws.AutoFilterMode = False
MsgBox "Rows Selected Lead Transfer for Parsing: " & (LR - 1) & vbLf & "Total Rows copied to Lead Trackers: " & MyCount & vbLf & "Hope They Match!!"
Application.ScreenUpdating = True
End Sub

Please Help!