vba routine in Excel 2002 to create varying size email in Outlook
 

This procedure runs in Excel.
It creates an email message based on the data in a worksheet.
It works perfectly, but where I'm stuck is in how to make the loop work.
That is, how do I add an extra line to the message in Outlook if 2 items are
purchased.

Option Explicit
Sub Outlook_Message_Purchases()
Dim objApp As Outlook.Application
Dim objMessage As Outlook.MailItem
Dim msg As String
Dim itemx As String
Dim Amountx As Currency, SubTotal As Currency
Dim sFirstName As String, email As String, Total As Currency, Postage As
Currency
Dim x As Integer

For x = 1 To 1 ' number of items purchased

itemx = Cells(17, x + 1)
Amountx = Cells(17, x + 2)

email = Cells(15, 2)
SubTotal = Amountx
Postage = Cells(25, 3) ' Postage line 25
Total = SubTotal + Postage

msg = msg & "Dear " & sFirstName & "," & vbCrLf & vbCrLf
msg = msg & itemx & vbTab & Format(Amountx, "$#,##0.00") & vbCrLf
msg = msg & "Your total purchases come to: " & Format(SubTotal,
"$#,##0.00") & vbCrLf
msg = msg & "The total including postage of " & Format(Postage,
"$#,##0.00") _
& " is " & Format(Total, "$#,##0.00") & vbCrLf

Next x

Set objApp = CreateObject("Outlook.Application")
Set objMessage = objApp.CreateItem(olMailItem)
With objMessage
.To = email
.BCC = "
.Subject = "Your Purchases"
.Body = msg
End With
objMessage.Display

Set objApp = Nothing
Set objMessage = Nothing

End Sub


--
Regards,
David