I am looking to have my spreadsheet send emails once a cell changes.
Thus far I have a macro to send to a group of emails and a command button macro to trigger this, but would like it to happen automatically when a cell changes state.
Now I have:
Sub Create_Email_From_Excel()
Dim SendTo As String
Dim ToMSg As String
For i = 1 To 10
SendTo = ThisWorkbook.Sheets(1).Cells(i, 1)
If SendTo <> “” Then
ToMSg = ThisWorkbook.Sheets(1).Cells(i, 3)
Send_Mail_From_Excel SendTo, ToMSg
End If
Next i
End Sub
Sub Send_Mail_From_Excel(SendTo As String, ToMSg As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = SendTo
.CC = "john#interwebs.com"
.BCC = “”
.Subject = "You have mail"
.Body = "this is your mail"
.Send
End With
And...
Private Sub CommandButton1_Click
Create_Email_From_Excel
End Sub
I'm not sure where to go from here or if I'm going in the right direction. The command button and macros work but I am at a loss to go any further.
If it could excecute the create email from excel macro when a cell in column G changes from "pending" to "Late" that would be outstanding.
Try Worksheet_Change event
Example
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
'
'When someone Edits the cell G1
'
Call Create_Email_From_Excel
'
'
End If
End Sub
Related
I'm trying to create a template where I can have VBA prompt me to change items in the subject. I've a template email with the subject line that should be Project / GC/Client, and in the template I've written that as #0# / #1#.
I'm at the below, but it's erroring.
Private Sub m_Inspector_Activate()
Dim Item As MailItem
Dim Value As String
If TypeOf m_Inspector.CurrentItem Is MailItem Then
Set mail = m_Inspector.CurrentItem
If mail.Subject = "subject" Then
Value = InputBox("Project")
mail.Subject = Replace(mail.Subject, "#0#", Value)
Value = InputBox("GC/Client")
mail.Subject = Replace(mail.Subject, "#1#", Value)
End If
End If
End Sub
This code is used on a template button in Outlook. i.e. the template file it is launching contains the subject line of #0# / #1#. Ideally, after the template launches, the macro prompts the user to update those two fields with the proper subjects.
Sub CommandButton1_Click()
Set MyItem = Application.CreateItemFromTemplate _
("V:\All Folders\Templates\Freebie.oft")
MyItem.Display
End Sub
If all that you really want to do is open a template and replace text in the subject line, this may work for you:
Sub CommandButton1_Click()
Call OpenTemplate
End Sub
Sub OpenTemplate()
Dim OutMail As Outlook.MailItem
Set OutMail = Application.CreateItemFromTemplate("V:\All Folders\Templates\Freebie.oft")
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Replace(.Subject, "#0#", InputBox("Project"))
.Subject = Replace(.Subject, "#1#", InputBox("GC/Client"))
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
If we can avoid using the Inspector then this is much simpler
How can I define a sub or function in VBA?
This is my code:
Private Sub CommandButton1_Click()
Call Send_Mail
End Sub
In Worksheet "Sheet1" I have a CommandButton called Send_Mail and in "Sheet2" I have also a CommandButton. When I click the CommandButton in Sheet2 I want that the Button in Sheet1 will run.
With my code the : error "Sub or Function is not defined" appears.
EDIT:
Code for Send_Mail:
Public Sub Send_Mail_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim nameList As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo cleanup
For i = 4 To 22
If Range("B4").Value <> "" Then
nameList = nameList & ";" & Range("C" & i).Value
End If
Next
With OutMail
.To = nameList
.Subject = "Subject Line"
.Body = "Body Text"
.Send
End With
cleanup:
Set OutApp = Nothing
MsgBox "E-Mail sent."
MsgBox Err.Description
End Sub
I don't know what the underlying sub procedure attached to the Sheet1 button has been named but it is likely it has a similar name.
'Sheet2's button sub procedure
Private Sub CommandButton1_Click()
Call Sheet1.CommandButton1_Click
End Sub
I'm by no means an expert and I want to send the multiple and different attachments (e.g. Person1 receives BOTH attch.1 and attach.2; Person2 receives attch.3 and attch. 5 etc).
My code:
Sub SendEmail(what_address As String, subject_line As String, mail_body As String)
Dim dlApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = what_address
olMail.Subject = subject_line
olMail.Body = mail_body
olMail.Send
End Sub
Sub SendMassEmail()
Dim mail_body_message As String
Dim title As String
row_number = 1
Do
DoEvents
row_number = row_number + 1
mail_body_message = Sheet1.Range("D2")
title = Sheet1.Range("B" & row_number)
mail_body_message = Replace(mail_body_message, "replace_name_here", title)
Call SendEmail(Sheet1.Range("A" & row_number), "This is a test", mail_body_message)
Loop Until row_number = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
End Sub
I think your code requires some work but the snippet below should help with adding multiple attachments. I have tried to add annotations that might be helpful.
Please note that the full path for each attachment must be known.
For example:
C:\TestFolder\TestSubfolder\TestFile.txt
You should be able to use the same looping concept to traverse across columns to handle multiple emails. It would be difficult to suggest the exact looping to be used without knowing the structure of your spreadsheet.
Sub GenerateEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim myRange As Range
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = Outlook.Application.CreateItem(olMailItem)
'This will only generate a single email with multiple attachments.
'You will need another loop or something similar to process multiple emails the loop could
'be similar to the loop below that use offset to go down rows but instead
'you will offest across columns
With OutMail
'I have used hard coded cell ranges to define the values but you can use other
'methods.
.Subject = Range("A1").Value
.To = Range("A2").Value
.CC = Range("A3").Value
.Body = Range("A4").Value
'This is where you list of attachments will start
Set myRange = Range("A5")
'Keep going down one cell until no more attachment values are provided
Do Until myRange.Value = ""
'The value here needs to be the full attachment path including file name and extension
.Attachments.Add (myRange.Value)
'Set the range to be the next cell down
Set myRange = myRange.Offset(1, 0)
Loop
'This displays the email without sending.
.Display
'Once the code is correct you can use the .Send instead to actually send the emails.
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I regularly issue Purchase Orders to vendors for my job, and either;
Write the email like a normal person or;
Use a macro to open a template that I have generated
Sub New_Email_from_PO_Template()
Dim myOlApp As Outlook.Application
Dim MyItem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItemFromTemplate("C:\Blah\template.oft")
MyItem.Display
End Sub
My aim is to eliminate the possibility of error by creating a userform, which will then populate a New E-mail window, allowing me to make any desired changes, and add attachments, before manually clicking [Send].
Included here is a Userform I have created.
The textboxes in the Userform that I have created are as follows;
RecipientName
PurchaseOrderNumber
PurchaseOrderDescription
Location
ProjectNumber
DateRequired
Following [SubmitButton], the data would then be populated into the Subject and Body fields in the New E-mail window.
Subject Line:
"PO# [PurchaseOrderNumber] - [PurchaseOrderDescription] - [Location]"
Body:
"To [Recipient_Name],
Please find attached Purchase Order (PO# [PurchaseOrderNumber]) pertaining to [PurchaseOrderDescription] for [Location]. Date Required: [DateRequired]
Thanks and Kind Regards, [User's Outlook Signature]"
The code I have developed is below;
Sub ShowPOSubmissionUserform()
POSubmissionEmailGenerator.Show
End Sub
Sub InitialisePOSubmissionUserform()
'Empty ProjectNumberTextbox
ProjectNumberTextbox.Value = ""
'Empty ProjectNameTextbox
ProjectNameTextbox.Value = ""
'Empty PONumberTextbox
PONumberTextbox.Value = ""
'Empty RecipientNameTextbox
RecipientNameTextbox.Value = ""
'Empty DateRequiredTextbox
DateRequiredTextbox.Value = ""
End Sub
Private Sub CloseButton_Click()
Unload Me
End Sub
Private Sub SubmitButton_Click()
'Creates a new e-mail item and modifies its properties
Dim OutlookApp As Object
Dim MItem As Object
Dim email_ As String
Dim subject_ As String
Dim body_ As String
Dim attach_ As String
Set OutlookApp = CreateObject("Outlook.Application")
email_ = POSubmissionEmailGenerator.ProjectNumberTextbox.Value
subject_ = "Hello this is the subject"
body_ = "Line 1" & vbNewLine & vbNewLine & "Line 3"
'create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = email_
.Subject = subject_
.Body = body_
End With
End Sub
At the moment, when pressing submit, NOTHING happens.
What needs to be added to make it at least open the New E-mail window?
With MItem
.To = email_
.Subject = subject_
.Body = body_
.Display '<<
End With
I am trying to send an email that will update users of changes to a spread sheet. I am trying to make it so that when the document is saved there will be an email automatically sent with a list of the changes.
Does anyone know if it is possible to automate email upon saving the document?
You can use this code here not fancy as Chip Pearson but easy to understand, This method also relies on using outlook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Outlook As Object, EMail As Object
Set Outlook = CreateObject("Outlook.Application")
Set EMail = Outlook.CreateItem(0)
With EMail
.To = "EmailAddress1#Server.com; Email2#aol.com"
.CC = ""
.BCC = ""
.Subject = "Put your subject here"
.Body = "Add you E-Mail Message Here"
.Attachments.Add ActiveWorkbook.FullName ' To add active Workbook as attachment
.Attachments.Add "C:\Test.xlsx" ' To add other files just use path, Excel files, pictures, documents pdf's ect.
.Display 'or use .Send to skip preview
End With
Set EMail = Nothing
Set Outlook = Nothing
End Sub
To set this up Here is the full guide:
First open up the VBA window using ALT + F11 then Select Worbook on the window to the right, Then workbook from the drop down:
Then from the Drop down on the right Select BeforeSave:
Then paste your code there:
You should end with this:
It should be. You'll need to place your code in the Workbook_BeforeSave event, so it is triggered when the workbook is saved.
Chip Pearson has a good article on Sending E-mail from VBA
You need to put the code in ThisWorkbook code section. Workbook_BeforeSave event is triggered before workbook is save. Hope below code gives you an idea how it can be accomplished.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Identify here list of changes
' You can pass as a string to SendMail
Dim strChanges As String
strChanges = "test"
SendMail strChanges
End Sub
Sub SendMail(msg 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
Set Flds = iConf.Fields
'Configure the below details
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "test-002"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "test#gmail.com"
.From = "test#gmail.com"
.Subject = "msg" & " " & Date & " " & Time
.TextBody = msg
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub