Send Mail with email address in 4 columns - vba

Question

I send email with Ron de Bruin's script where it has option for sending of email address from column B value.
I have at least 4 columns of email address from column B to E. How can I modify this to send this e-mail?
Example:
Make a list in Sheets("Sheet1") with :
In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this: C:\Data\Book2.xls (doesn't have to be Excel files)
The macro will loop through each row in Sheet1 and if there is an e-mail address in column B and file name(s) in column C:Z it will create a mail with this information and send it.
Sub Send_Files()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*#?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Answer 1

MASSIVE EDIT
As per your comment, the code below is changed. Should be working under the assumption that there is a filename in Column F. The lines to remove/comment out are marked in the code below in case you don't want this requirement.
Private Sub Send_Files()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'--BK201 mod: http://stackoverflow.com/questions/20776481/send-mail-with-email-address-in-4-columns--'
Dim OutApp As Object
Dim OutMail As Object
Dim Sh As Worksheet
Dim FileCell As Range
Dim Rec As Range, RecRng As Range, RecList As Range, RecMail As Range
Dim FileRng As Range
Dim RecStr As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set Sh = ThisWorkbook.Sheets("Sheet1")
Set RecList = Sh.Range("B:B")
Set OutApp = CreateObject("Outlook.Application")
For Each Rec In RecList
With Sh
Set RecRng = .Range("B" & Rec.Row & ":E" & Rec.Row)
Set FileRng = .Range("F" & Rec.Row)
End With
RecStr = ""
For Each RecMail In RecRng
If RecMail.Value Like "?*#?*.?*" Then
RecStr = RecStr & RecMail.Value & ";"
End If
Next RecMail
If Len(FileRng.Value) > 0 Then '--Comment out if alright to send without attachment.
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = RecStr
.Subject = "Testfile"
.Body = "Hi " & Rec.Offset(0, -1).Value
On Error Resume Next
For Each FileCell In FileRng
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display '.Send
End With
Set OutMail = Nothing
Else '--Comment out if alright to send without attachment.
Exit For '--Comment out if alright to send without attachment.
End If '--Comment out if alright to send without attachment.
Next Rec
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Set-up:
Result:
Hope this helps. :)