PDA

View Full Version : Need help copying cell values to email body



avadhutd2
03-22-2010, 10:55 PM
Hi,

Greetings!

I have a requirement where I need to copy few cells along with the items count from worksheets to an email body & send that.

For example -
If we consider sheet1 & column1 with entries as follows -

TestEntry ' This is a column heading
T1
T2
T1
T1
T3
T3
T2

I need count in email body as below -
T1 3
T2 2
T3 2

This was for sheet1. Similar things will be there for Sheet2 & so on....till number of sheets are over.

The email body may look like this after all the sheets are over:

Sheet1
T1 3
T2 2
T3 2

Sheet2
T1 2
T2 1
T3 4

Sheet3
T1 1
T2 2
T3 3

etc....

I had attached a sample sheet where the work can be done.

Need help in this regard....

Thanks in advance!!

lucas
03-23-2010, 09:45 PM
See attached example.
Option Explicit
'requires a reference to the microsoft outlook xx.0 Object Library
Sub eMailActiveDocument()
Dim OL As Object
Dim EmailItem As Object
Dim Bk As Workbook
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Bk = ActiveWorkbook
Bk.Save
With EmailItem
.Subject = "Insert Subject Here"
.Body = "Sheet1" & vbCrLf & "T1: " & Bk.Sheets("Sheet1").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet1").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet1").Range("K3").Value & vbCrLf & vbCrLf & _
"Sheet2" & vbCrLf & "T1: " & Bk.Sheets("Sheet2").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet2").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet2").Range("K3").Value & vbCrLf & vbCrLf & _
"Sheet3" & vbCrLf & "T1: " & Bk.Sheets("Sheet3").Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets("Sheet3").Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets("Sheet3").Range("K3").Value
.To = "User@Domain.Com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
' .Attachments.Add Bk.FullName
' .Send
.Display
End With

Application.ScreenUpdating = True
Set Bk = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub

avadhutd2
03-23-2010, 10:56 PM
Thanks a lot for reply...I tried that & it helps.

One thing I need to ask here is in case I have more than 3 sheets ....I mean I am not aware what the sheet count is, then how we can take care in this code?

Please let me know...

Thanks again for your help!!

mdmackillop
03-24-2010, 06:45 AM
Something like

For i = 1 To Sheets.Count
txt = txt & Sheets(i).Name & vbCrLf & "T1: " & Bk.Sheets(i).Range("K1").Value & vbCrLf & _
"T2: " & Bk.Sheets(i).Range("K2").Value & vbCrLf & "T3: " & Bk.Sheets(i).Range("K3").Value & vbCrLf & vbCrLf
Next
With EmailItem
.Subject = "Insert Subject Here"
.Body = txt
.to = "User@Domain.Com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
' .Attachments.Add Bk.FullName
' .Send
.Display
End With