Auto-email based on cell value change?

[vincent]

I have a shared workbook we use for internal
communication/collaboration.

Is there anyone that can generate vis basic code that would send an
email out automatically based on a cell changing to a certain value?
we use Outlook

e.g., if in a range of cells, a cell changes to a certain value, an
email would automatically be sent out to a certain list of people, with
a certain message text.

 

[ilia]

Insert this code in VBA Worksheet_Change event. You will need
Microsoft Outlook library included in your references, as well as ADO
if you use it like I do. Remember, Outlook will display error messages
when you try to use it to send an e-mail from another program. Try
this bit, if you can get it installed on your client's machine, to get
the job done: http://www.contextmagic.com/express-clickyes/
You can set this software to activate/deactivate from within your VBA
code.

Another way is to use a command-line SMTP program to do this; in that
situation, you will need the program installed or network-accessible to
the end user. This is the one I use, free of license restrictions and
fees: http://www.blat.net/

Here is code that I use to send Outlook-based e-mails:

' separate the Dim from the New if you want to do some error-trapping
in that respect
Dim objOutlook As New Outlook.Application
Dim objEmail As New Outlook.MailItem

' I'm using an ADO library Recordset object, to get data from an MS
Access table
Dim rsAssignments As New ADODB.Recordset
' Connection to be established, see ADO documentation to set this up
' if you're not using recordsets, see below; just ignore the
rsAssignments reference
rsAssignments.ActiveConnection = CurrentProject.Connection
' this is the name of the record source; it can also be the name of
an SQL query
' that retrieves the data from your spreadsheet
rsAssignments.Open "qryActiveNonMatched"

Set objEmail = objOutlook.CreateItem(olMailItem)
' this is where you select recepients
objEmail.Recipients.Add "iasafiev"
'subject text
objEmail.Subject = "This is an automatically generated e-mail"
'body text
objEmail.Body = "The following staff are not assigned: " & vbCrLf &
vbCrLf

' what happens here is i am looping through the query (selected using
..Open above)
' to enter each of the records in the result into the email body
Do While Not rsAssignments.EOF

' replace rsAssignments("HOMEDEPARTMENTS")
' with a reference to the worksheet cells you want to have e-mailed
objEmail.Body = objEmail.Body & rsAssignments("NAME") & " " &
rsAssignments("HOMEDEPARTMENT") & vbCrLf
' ignore this; all it does is move to the next record in the query
rsAssignments.MoveNext
Loop

' ignore this if you're not using a recordset object
rsAssignments.Close

' here the e-mail is actually sent
' you will still have to deal with Outlook warnings, since there isn't
an easy way
' to deal with Outlook warnings, not like in Excel and Access
objEmail.Send
objOutlook.Quit

objEmail = Nothing
objOutlook = Nothing

--------------------

This is how I use the blat software to send e-mails - this does not
require Outlook warning handling. This particular example also
attaches an excel spreadsheet using command-line parameters:

Sub send_email(fileLocation As String)
Dim server As String
Dim subj As String
Dim body As String
Dim command As String
Dim windowType As VbAppWinStyle
Dim carbonCopy As VbMsgBoxStyle

' Chr(34) is ASCII for double quotes ["]
subj = Chr(34) & "Consultant timesheet - " & getCurrentUserName() &
Chr(34)

body = Chr(34) & "This is an automatically generated message. " & _
"Please do not respond to this e-mail." & vbCrLf & vbCrLf &
_
"The following consultant has submitted his/her timesheet:
" & vbCrLf & _
vbTab & getCurrentUserName() & vbCrLf & _
"Please review the attached file, and submit a signed copy
to Finance." & _
vbCrLf & vbCrLf & "Thank you for your help." & Chr(34)

server = "-install " & getSystemData("smtpServerName") & _
" " & getSystemData("smtpFromName")
command = "-to " & getCurrentUserSupervisor() & " -subject " & subj
& _
" -body " & body & " -attach " & fileLocation

carbonCopy = MsgBox("Would you like to receive a copy of the
timesheet via e-mail?", _
vbYesNo + vbQuestion, "Notification")

If (carbonCopy = vbYes) Then
command = command + " -cc " & _
InputBox("Enter your e-mail address:", "Certify
Timesheet") & _
" -u " &
mdlUserTools.getSystemData("smtpAuthenticateUser") & _
" -pw " &
mdlUserTools.decodePassword(getSystemData("smtpAuthenticatePassword"))
End If

If (debugMode) Then
Call MsgBox(server & vbCrLf & command & vbCrLf, , "Email
notification")
Debug.Print command
End If

If (debugMode) Then
windowType = vbMaximizedFocus
Else
windowType = vbHide
End If

If (debugMode) Then
Call MsgBox("Before BLAT server call" & vbCrLf & _
getSystemData("blatProgramLocation") & "\blat.exe "
& server, _
vbOKOnly, "Notifying Director")
End If
Call Shell(getSystemData("blatProgramLocation") & "\blat.exe " &
server, windowType)
If (debugMode) Then
Call MsgBox("BLAT server call successful!" & vbCrLf & _
"Before BLAT command call" & vbCrLf & _
getSystemData("blatProgramLocation") & "\blat.exe "
& command, _
vbOKOnly, "Notifying Director")
End If
Call Shell(getSystemData("blatProgramLocation") & "\blat.exe " &
command, windowType)
End Sub



Hope this helps, I would be happy to clarify regarding any question
that might arise.

-Ilia

 

[Ron de Bruin]

You can try this vincent
http://www.rondebruin.nl/mail/change.htm

 

[vincent]

Hi Ron

for a newbie like me, this is a little easier to follow. however, i
should clarify i need the email to be sent when ANY cells from a column
of cells changes to a certain value. this also should work from a
shared workbook...i have had problems with macros after you share the
workbook?

Vincent

 

[Ron de Bruin]

should clarify i need the email to be sent when ANY cells from a column
Are they all formulas

of cells changes to a certain value

What is the value ?

shared workbook

Always trouble

 

[vincent]

No, it is not a formula. It has validation applied, to restrict person
from entering anything but certain values. The context is a design
project log that this macro would help notify certain people that a
design has been "flipped" to DONE.

(Value is "DONE")

 

[Ron de Bruin]

Hi vincent

This will work for column A

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
If Target.Value = "DONE" Then
YourMacroName
End If
End If
End Sub

If it is possible use the CDO code
No security warnings then