PDA

View Full Version : Send cell contents in email message body



Sir Babydum GBE
07-04-2008, 08:22 AM
Hi

In the middle of some code I have, I want to get the code to check a cell, say, A1. If it's not empty, I want an email to be generated and sent in the background to a specific individual (e.g. Babydum@hotmail.com) with the contents of A1 in the message body.

Can I do this?

Thanks

And hello after such a long time.

marshybid
07-04-2008, 09:04 AM
OK, I saw some code that xld posted a while ago about creating an email in excel using VBA.

I have added a sub to get the msgbody (value of A1) then call the code that xld posted to create the mail.

Unfortunately I can't test as we use Lotus Notes at work :banghead:

Let me know if it works, bear in miond this is only loo9king for a value in cell A1 (as per your request) and assumes that the recipient address is always the same.


Sub GetMsg()
Dim msgbody As String
On Error Resume Next
If range("A1") <> 0 Then
msgbody = range("A1").Value
Call CreateMail
End If
On Error GoTo 0
End Sub

Private Sub CreateMail()
Dim oOutlook As Object
Dim oMailItem As Object
Dim oRecipient As Object
Dim oNameSpace As Object


Set oOutlook = CreateObject("Outlook.Application")
Set oNameSpace = oOutlook.GetNameSpace("MAPI")
oNameSpace.Logon , , True


Set oMailItem = oOutlook.CreateItem(0)
Set oRecipient = _
oMailItem.Recipients.Add("Babydum@hotmail.com")
oRecipient.Type = 1 '1 = To, use 2 for cc
'keep repeating these lines with
'your names, adding to the collection.
With oMailItem
.Subject = "Email for you"
.Body = msgbody
' .Attachments.Add ("filename") 'you only need this if
'you are sending attachments?
.Display 'use .Send when all testing done
End With
End Sub


Marshybid

Charlize
07-07-2008, 03:02 AM
Hi

In the middle of some code I have, I want to get the code to check a cell, say, A1. If it's not empty, I want an email to be generated and sent in the background to a specific individual (e.g. Babydum@hotmail.com) with the contents of A1 in the message body.

Can I do this?The cdo way by using the company server.Sub check_A1()
If ActiveSheet.Range("A1") <> vbNullString Then
'if your company's website is www.babydum.com (http://www.babydum.com), name of server is server01
'then myserveraddress = server01.babydum.local
Call Babydum("babydum@hotmail.com", "server01.babydum.local")
End If
End Sub
Private Sub Babydum(myaddress As String, myserveraddress As String)
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'if your company's website is www.babydum.com (http://www.babydum.com), name of server is server01
'then myserveraddress = server01.babydum.local
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
myserveraddress
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
'************
'Send an email
With iMsg
Set .Configuration = iConf
.From = """Babydum"" <babydum@babydum.com>"
.To = myaddress
'.Cc = "xxx"
.Subject = "Changing of A1" & _
Format(Now, "dd/mm/yyyy HH:MM:SS")

'Don't remove TextBody. The attachments can not be opened when received.
'Bug in CDO
.TextBody = "A little summary of the info you want at " & _
Format(Now, "dd/mm/yyyy HH:MM:SS") & vbCrLf & vbCrLf & _
"Thanks for the info." & vbCrLf & vbCrLf & _
"Babydum"
'.addattachment
.Send
'since you don't get a message in sent items, we need a copy
'for our self that I usually sent to the address in from
.To = "babydum@babydum.com"
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
End SubCharlize