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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.