Email Information from Sheet & Loop

[XfortunaX]

I need help!

I am looking to create and send an email from information stored on a sheet sent from my my (2) Outlook address.

Issues:
The loop I have tried errors out on the second person.
The length of rows changes every week.
The outlook item (2) still pulls address (1)

The details:
Column A: Employee Name (irrelevant for this)
Column B: File Name (Irrelevant for this)
Column C: Employee Email
Column D: File Path to attachment



Sub Mail_workbook_Outlook_1()


Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

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


strbody = "Good afternoon," & vbNewLine & vbNewLine & _
"Attached is your portion of the American Express bill - closing date 04.28.2015." & vbNewLine & vbNewLine & _
"Within the attached excel document, you will find 3 tabs:" & vbNewLine & vbNewLine & _
"Tab 1 (Your Name): All charges on your American Express for the period. Please review for accuracy and fraudulent activity. If there appears to be fraudulent activity, please contact finance immediately. On this sheet, you will complete the code column by filling in a number found on the Chart of Accounts (Chart of Accounts located on the Amex Instructions page or Tab 2) for the charge, write who was present, and write what the purpose was. Once complete, please write your name and date in the space provided." & vbNewLine & vbNewLine & _
"Tab 2 (AMEX Instructions): This sheet includes brief instructions on the overall process, the Chart of Accounts (used for coding each charge), and examples of what charges would fall under which code numbers." & vbNewLine & vbNewLine & _
"Tab 3 (AMEX Receipt Return): Please print and sign this page and return with your receipts to your manager." & vbNewLine & vbNewLine & _
" If you received this electronically, please return this to your manager electronically. Please print the Receipt Return page, sign, and send in with your receipts to your manager." & vbNewLine & _
" If you are receiving a hardcopy of your American Express bill, please return to your manager signed and with receipts." & vbNewLine & _
" If there appears to be fraudulent activity, please contact finance immediately." & vbNewLine & vbNewLine & _
"If you have any questions, please do not hesitate to ask John or Eileen by phone or sending an email to EiFinance@horizonsalescorp.com" & vbNewLine & vbNewLine & _
"Thank you!" & vbNewLine & vbNewLine & _
"Jr" & vbNewLine & vbNewLine & _
"Phone: 949 218 XXXX" & vbNewLine & _
"Email: EiFinance@salecorp.com"


On Error Resume Next
x = 2
Do While Cells(x, 1)

With OutMail
.To = Cells(x, 3)
.CC = ""
.BCC = ""
.Subject = "Platinum_04.28.2015"
.Body = strbody
.Attachments.Add Cells(x, 4)
'You can add other files also like this .Attachments.Add ("C:\test.txt")
'Change Item(1)to the account number that you want to use HS. is (1) and Finance. is (2)
.SendUsingAccount = OutApp.Session.Accounts.Item(2)
.Display 'or use .Send


End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing


x = x + 1
Loop

End Sub


Thank you for any help that can be provided!

- JT