PDA

View Full Version : Paste selection as Message Body



excelliot
04-26-2007, 04:58 AM
I am trying to send email in which i am trying to paste selected dada on sheet as message body but it is not working why??

I have insrted new module in which i have pasted code.



Sub Newmail()

Dim oOutlookApp As Object
Dim oOutlookMail As Object

On Error Resume Next
'Use current Outlook app if running
'After pressing send the mail is send right away
Set oOutlookApp = GetObject(, "Outlook.Application")

'Not running create a new instance of Outlook
If Err <> 0 Then
'After pressing send the email wil stay in Outbox til you open
'Outlook again and press send receive
Set oOutlookApp = CreateObject("Outlook.Application")
End If
'Create and show the outlook mail item
If Not oOutlookApp Is Nothing Then
Set oOutlookMail = oOutlookApp.CreateItem(0)
If Not oOutlookMail Is Nothing Then
With oOutlookMail
.Subject = "Your Data"

ActiveSheet.Selection.Copy
.Body = ActiveSheet.Selection.Paste
.Display
End With
End If
End If

'Clean up
Set oOutlookMail = Nothing
Set oOutlookApp = Nothing
End Sub

Bob Phillips
04-26-2007, 05:02 AM
See http://www.rondebruin.nl/mail/folder2/mail4.htm for how to do it.

excelliot
04-26-2007, 11:38 PM
I did not find anything right there.

I want so send some selected cells at different area via email, either It is already selected then macro is run or Macro asks for data to select i tried doing with follo code but it is giving error??


Sum mail ()
'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

Set Source = Nothing
On Error Resume Next
'Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible)
Set Source = Application.InputBox("Select Range", Type:=8)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = True
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
.SendMail "ENTER EMAIL (vjoshi@gulfoil.co.in)", _
"This is the Subject line"
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

CCkfm2000
04-27-2007, 10:05 AM
hi excelliot,

i've used this code for some of my spreadsheets....

Dim currentsheet As String
Dim Msg As String
Dim stockfigure As Integer
Dim exportfigure As Integer
Sub Send_Msg()
Sheets("sheet1").Select
stockfigure = Range("b2")
exportfigure = Range("c2")
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
Application.DisplayAlerts = False
With objMail
.To = "to.how@where.com"

.Subject = "subject here"

Msg = "Good Morning Susan / Alan," & vbCrLf & vbCrLf
Msg = Msg & "Here are the figures for " & (Range("d2")) & vbCrLf & vbCrLf
Msg = Msg & "Stock Figure is :- " & (Range("b2")) & vbCrLf & vbCrLf
Msg = Msg & "Export Figure is :-" & (Range("c2")) & vbCrLf & vbCrLf
Msg = Msg & "Have a nice day..." & vbCrLf & vbCrLf
Msg = Msg & "From the Cold Store Team"
.Body = Msg
.Display
'.Send
End With

Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s"

Set objMail = Nothing
Set objOL = Nothing

Application.DisplayAlerts = True

End If
End If

Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s"

Set objMail = Nothing
Set objOL = Nothing

Application.DisplayAlerts = True
End Sub