VBA Email when save problems! Need help with attachments and multiple email address'

[chrismacldn]

I have this code in VBA which currently works perfectly fine but I want to add to it and cant seem to get my head around it.

As it stands, when you press save on the workbook it automatically sends an email to the email address in the code stating the date and time the work book was updated.

Things I want to add:

1. I would like the email to send to multiple email address'
2. I would like to include the updated workbook as an attachment
3. If possible I would like the email to also include the PC username of the person who updated the workbook.

Help on any of these would be greatly appreciated as I've been stuck for weeks!

Thanks Guys!

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)


Dim answer As String


answer = MsgBox("Are you sure you want to update the rota?", vbYesNo, "Rota Update")


If answer = vbNo Then Cancel = True
If answer = vbYes Then
'open outlook type stuff
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
'add recipients
'newmsg.Recipients.Add ("Name Here")
newmsg.Recipients.Add ("EMAIL ADDRESS 1")
'add subject
newmsg.Subject = "Rota Update"
'add body
newmsg.Body = "Rota Update " & Format(Now, "dd-mmm-yy h-mm-ss")
newmsg.Display 'display
newmsg.Send 'send message
'give conformation of sent message
MsgBox "The rota has been updated, thank you.", , "Rota Update"








End If




'save the document
'Me.Worksheets.Save


End Sub

 

[chrismacldn]

I've cracked the first one, just entered the same thing below with another email address and it works, only need help on 2 and 3 now!

Thanks guys!

New code below:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)


Dim answer As String


answer = MsgBox("Are you sure you want to update the rota?", vbYesNo, "Rota Update")


If answer = vbNo Then Cancel = True
If answer = vbYes Then
'open outlook type stuff
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
'add recipients
newmsg.Recipients.Add ("blah@foo.com")
newmsg.Recipients.Add ("here@there.co.uk")
'add subject
newmsg.Subject = "Rota Update"
'add body
newmsg.Body = "Rota Update " & Format(Now, "dd-mmm-yy h-mm-ss")
newmsg.Display 'display
newmsg.Send 'send message
'give conformation of sent message
MsgBox "The rota has been updated, thank you.", , "Rota Update"








End If




'save the document
'Me.Worksheets.Save


End Sub

 

[RedBeard]

Have a look here: Mail from Excel with Outlook (VBA)

 

[chrismacldn]

Have a look here: Mail from Excel with Outlook (VBA)

I attempted to add the Add Attachment code from that side, I inserted it under the email body as it is on that site but when I ran it it flagged up as an error? Can't seem to get it in the right place for it to work.

'add subjectnewmsg.Subject = "Rota Update"
'add body
newmsg.Body = "Rota Update " & Format(Now, "dd-mmm-yy h-mm-ss")
'.Attachments.Add ("C:\Users\christopherm\Desktop\Surveillance\Surveillance Admin\Rotas\Surveillance Rota 2016.xlsm")
newmsg.Display 'display
newmsg.Send 'send message
'give conformation of sent message
MsgBox "The rota has been updated, thank you.", , "Rota Update"

 

[chrismacldn]

Any new help guys? Still stuck!