PDA

View Full Version : Send E-Mail via Macro if Workbook was saved and the was name changed aswell



Fabbby-San
03-14-2018, 02:30 AM
Hi all,

I got a little problem that I canīt quite solve with my VBA knowledge, unfortunatley. I want a macro that automatically sends an e-mail if two conditions are met 1. that the workbook was saved and 2. that the name of this workbook was changed aswell. I used the following code, but it does not seem to do the trick. As highlighted I tried it with an If-statement with two conditions. I open and thankful for any helping suggestions.

Option Explicit


'Send email if name of workbook is changed


Private Sub WorkbookName_Change()
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String, xName As String, wbName As String
Dim Change

On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wbName = ThisWorkbook.Name

If ThisWorkbook.Saved = True Then
If wbName <> ActiveWorkbook.Name Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Hallo," & Chr(13) & Chr(13) & "Fyi, die Datei wurde geupdated :)."
With xMailItem
.To = ""
.CC = ""
.Subject = "Worksheet modified in " & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

kind regards,
Felix

MINCUS1308
03-14-2018, 11:41 AM
IN THE ThisWorkbook MODULE:


Public InitialName

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
InitialName = ActiveWorkbook.Name
End Sub

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

If Not Success Then Exit Sub
If ActiveWorkbook.Name <> InitialName Then SendEmail
End Sub

Sub SendEmail()
'YOUR EMAIL SUB GOES HERE
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String, xName As String, wbName As String
Dim Change
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Hallo," & Chr(13) & Chr(13) & "Fyi, die Datei wurde geupdated ."
With xMailItem
.To = ""
.CC = ""
.Subject = "Worksheet modified in " & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With

Set xOutApp = Nothing
Set xMailItem = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Fabbby-San
03-15-2018, 02:39 AM
Thanks a lot, that works excactly as I imagined :):)

nathandavies
03-15-2018, 03:03 AM
Very nice never thought of creating a email for tracking changes.

Mincus, might try something like this for my problem.
http://www.vbaexpress.com/forum/showthread.php?62254-VBA-Code-to-create-a-list-of-changes-from-a-workbook

MINCUS1308
03-15-2018, 06:09 AM
ha, that's surprising (the fact that it worked)
Welcome to the fourm Fabbby-San

If you can, please mark the thread as solved by going to the 'Thread Tools' button at the top right corner of the thread.

MINCUS1308
03-15-2018, 06:14 AM
nathandavies,

You certainly could apply this methodology to your problem.
Just change the events from BeforeSave and AfterSave to SelectionChange and Change
and modify the sub/logic a little.