Send Range to Outlook and Email it
 

Hi, I have written code, which will search through a range pasted from
another sheet, select it. I want to store this range in an array and send it
in an outlook email based on the email address located in Column B. Here is
my code - LastCopiedRow is the currently selected row of data:


Range("A" & LastCopiedRow + 1) = "Department"
Range("B" & LastCopiedRow + 1) = "E-mail"
Range("C" & LastCopiedRow + 1) = "Last Name"
Range("D" & LastCopiedRow + 1) = "First Name"
Range("E" & LastCopiedRow + 1) = "Start Date"
Range("F" & LastCopiedRow + 1) = "Position Title"
Range("G" & LastCopiedRow + 1) = "Initial Review Date"
Range("H" & LastCopiedRow + 1) = "Satisfactory?"
Range("J" & LastCopiedRow + 1) = "Current Review Date"
Range("A" & LastCopiedRow + 1 & ":J" & LastCopiedRow + K + 1).Select

Dim EmailArray() As Variant
EmailArray = Range("A" & LastCopiedRow + 1 & ":J" & LastCopiedRow + K + 1)

SendEmail (EmailArray)



Sub SendEmail(ByRef EmailArray As Variant)

ThisSelection = Selection
'Sets Outlook variables
Dim olApp As Outlook.Application
Dim olMail As MailItem
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)


With olMail
'Send email to address in column A
.To = "
'ActiveSheet.Range("B2").Text
'.from = "
.Subject = "Employee Reviews Due"
'Include employee information in email
.Body = EmailArray
.Display
.Send
End With

'Reset variables to nothing
Set olMail = Nothing
Set olApp = Nothing
--
Markb