[Solved] Send Email when Excel File gets Unprotected

Is there any way to send email by vb script when Excel file gets unprotected?
Hello Faisal,

Fortunately, yes! There is a way to get an email when Excel file gets unprotected. Here is the custom code to do so:
Code:
Dim objExcel, objWorkbook, objShell
Dim strExcelFilePath, strPassword

' Set the path to the Excel file and the password (if any)
strExcelFilePath = "C:\Path\To\Excel\File.xlsx"
strPassword = "password"

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(strExcelFilePath, , False, , , strPassword)

' Check if the workbook is protected
If objWorkbook.ProtectStructure = False Then
    ' Unprotected - perform necessary actions and send an email
    ' Your code to perform actions when the file is unprotected

' Send email using Outlook
    Dim objOutlook, objMail
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
' Configure email properties
    objMail.Subject = "Excel file unprotected"
    objMail.Body = "The Excel file has been unprotected."
    objMail.To = "*********************"
    
' Send the email
    objMail.Send

' Clean up objects
    Set objMail = Nothing
    Set objOutlook = Nothing
End If

' Close and clean up Excel objects
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

Set objShell = CreateObject("WScript.Shell")
objShell.Popup "Email sent successfully.", 3, "Email Notification"
Set objShell = Nothing
Please, ensure you update the following parts of the code according to your requirements:
  • strExcelFilePath: Specify the path to your Excel file.
  • strPassword: If your Excel file is password protected, provide the password. Otherwise, leave it as an empty string ("").
  • objMail.Subject: Set the subject of the email.
  • objMail.Body: Set the body/content of the email.
  • objMail.To: Specify the recipient email address.
Note: Also make sure you have Microsoft Outlook installed.

Hope this works for you!

Best Regards,
Yousuf Shovon
 
Hello Faisal,

Fortunately, yes! There is a way to get an email when Excel file gets unprotected. Here is the custom code to do so:
Code:
Dim objExcel, objWorkbook, objShell
Dim strExcelFilePath, strPassword

' Set the path to the Excel file and the password (if any)
strExcelFilePath = "C:\Path\To\Excel\File.xlsx"
strPassword = "password"

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(strExcelFilePath, , False, , , strPassword)

' Check if the workbook is protected
If objWorkbook.ProtectStructure = False Then
    ' Unprotected - perform necessary actions and send an email
    ' Your code to perform actions when the file is unprotected

' Send email using Outlook
    Dim objOutlook, objMail
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
   
' Configure email properties
    objMail.Subject = "Excel file unprotected"
    objMail.Body = "The Excel file has been unprotected."
    objMail.To = "*********************"
   
' Send the email
    objMail.Send

' Clean up objects
    Set objMail = Nothing
    Set objOutlook = Nothing
End If

' Close and clean up Excel objects
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

Set objShell = CreateObject("WScript.Shell")
objShell.Popup "Email sent successfully.", 3, "Email Notification"
Set objShell = Nothing
Please, ensure you update the following parts of the code according to your requirements:
  • strExcelFilePath: Specify the path to your Excel file.
  • strPassword: If your Excel file is password protected, provide the password. Otherwise, leave it as an empty string ("").
  • objMail.Subject: Set the subject of the email.
  • objMail.Body: Set the body/content of the email.
  • objMail.To: Specify the recipient email address.
Note: Also make sure you have Microsoft Outlook installed.

Hope this works for you!

Best Regards,
Yousuf Shovon
Thanks for the help but how to trigger the module? Can you please guide

Regards,
 
Thanks for the help but how to trigger the module? Can you please guide
Hello Faisal,
Thanks again for your concern. Excel provides no in-built event to trigger the module when you unprotect the workbook. Workbook_WindowDeactivate event is the closest we have that triggers an event when a window or dialog box is closed, but it also does not detect the closing of Unprotect Sheet window. That is because unprotecting a workbook is a system-level window event that can not be detected with in-built workbook events in Excel.

Fortunately, you can trigger the module with Worksheet_Activate, Worksheet_Change, Worksheet_Deactivate or Worksheet_SelectionChange events. That means, the VBA code won't trigger when someone unprotects the sheet but it will trigger and send a mail when he/she opens, changes or select the sheet after unprotecting it.

Here is the VBA code to get a mail with the mentioned events:
Code:
Sub SendEmail(recipient As String, message As String)

    Dim OutlookApp As Object
    Dim OutlookMail As Object

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)

    With OutlookMail
        .To = recipient
        .Subject = "Sheet1 Unprotected"
        .Body = message
        .Send
    End With

    Set OutlookMail = Nothing
    Set OutlookApp = Nothing

End Sub

Private Sub Worksheet_Activate()

    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Sheets("Sheet1")

    If Sh.ProtectContents = False Then
        SendEmail "[email protected]", "Sheet1 has been unprotected"
    End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Sheets("Sheet1")

    If Sh.ProtectContents = False Then
        SendEmail "[email protected]", "Sheet1 has been unprotected"
    End If

End Sub

Private Sub Worksheet_Deactivate()

    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Sheets("Sheet1")

    If Sh.ProtectContents = False Then
        SendEmail "[email protected]", "Sheet1 has been unprotected"
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Sheets("Sheet1")

    If Sh.ProtectContents = False Then
        SendEmail "[email protected]", "Sheet1 has been unprotected"
    End If

End Sub

Private Sub Workbook_Open()

End Sub
Remember to set your mail address in the code. I have also attached the Excel file for better understanding.

Regards,
Yousuf Shovon
 

Attachments

  • MFaisal.xlsm
    13.2 KB · Views: 2
Last edited:

Online statistics

Members online
0
Guests online
25
Total visitors
25

Forum statistics

Threads
303
Messages
1,331
Members
550
Latest member
JasonRip
Top