mfaisal.ce
Member
Dear,
Is there any way to send email by vb script when Excel file gets unprotected?
Regards,
Is there any way to send email by vb script when Excel file gets unprotected?
Regards,
Hello Faisal,Is there any way to send email by vb script when Excel file gets unprotected?
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
Thanks for the help but how to trigger the module? Can you please guideHello Faisal,
Fortunately, yes! There is a way to get an email when Excel file gets unprotected. Here is the custom code to do so:
Please, ensure you update the following parts of the code according to your requirements: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
Note: Also make sure you have Microsoft Outlook installed.
- 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.
Hope this works for you!
Best Regards,
Yousuf Shovon
Hello Faisal,Thanks for the help but how to trigger the module? Can you please guide
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