Sending email with multiple attachments

[MadMak0203]

I found information to send an email with attachments using an exce
spreadsheet. It is working perfectly. I now need to update it so tha
I can add multiple attachments. The documents reside in columns c:m.
Any ideas?

Sub Test()
Dim ExcelObject As Object
Dim OutlookApp As Outlook.Application
Dim NewMessage As Outlook.MailItem
Dim OutlookNamespace As Outlook.NameSpace
Dim fName, fLoc, eAddress As String
Dim fNameAddress, fLocAddress, eAddressAddress As String
Dim strHTMLBody As String


' Set up the spreadsheet you want to read
On Error Resume Next
Set ExcelObject = GetObject(, "Excel.Application")
If Not Err.Number = 0 Then
MsgBox "You need to have Excel running with the appropriat
spreadsheet open first", vbCritical, "Excel Not Running"
End
End If

' Read in the data and create a new message with attachment for eac
Excel entry
CellRow = 1
Set OutlookApp = Outlook.Application
Do Until ExcelObject.Range(fNameAddress) = ""
fNameAddress = "A" & CellRow
eAddressAddress = "B" & CellRow
fLocAddress = "C" & CellRow
fName = ExcelObject.Range(fNameAddress)
fLoc = ExcelObject.Range(fLocAddress)
eAddress = ExcelObject.Range(eAddressAddress)
fName = fLoc & "\" & fName
Set OutlookApp = Outlook.Application
Set NewMessage = OutlookApp.CreateItem(olMailItem)
Set myAttachments = NewMessage.Attachments
myAttachments.Add fLoc
With NewMessage
.Recipients.Add eAddress
.Attachments = fLoc
.Display
.Subject = "Action Required: FY13 Budget Development Form"
.HTMLBody = strHTMLBody
strHTMLBody = "<br><FONT FACE=TAHOMA> Attached find you
school's budget form.
' .Send
End With
CellRow = CellRow + 1
fNameAddress = "A" & CellRow
Loop
End Su