|
TRaP
Moderator
Inregistrat: acum 8 ani
Postari: 951
|
|
Changed title from "Run Daily" to "Run Periodically"
*
I have an e-mail alert system set up for a colleague to run every month on the 1st. If he does not turn on the computer on the 1st of the month, the code will run the first time he will. This is set through both Excel VBA and the Task Scheduler.
This uses the New Outlook which will become mandatory in the near future. The New Outlook isn't linked directly to VBA so you cannot do a simple email.Send VBA command anymore. You require an additional helper, and I used an AutoHotkey script compiled as an executable ("send mail.exe"). Please see code at the end of this post. No admin rights are required to create and compile the code to .exe, you just need AutoHotkey Portable downloaded to local PC.
I included the 2 VBA codes below - MonthlyRun and Email_Alert_BVM_Send subroutines - in a blank excel file called ALERTE_MAIL.xlsm.
The code below contains a Subroutine called MonthlyRun which records an entry into the Windows Registry for the current user (no admin required) with the current year-month (yyyy-mm format) after the code in Subroutine Email_Alert_BVM_Send has ran. Task scheduler runs MonthlyRun daily on computer logon. MonthlyRun first checks if the registry key corresponds to the current month - meaning that the code has already ran this month - and exits. If it has not, it runs once.
Sub MonthlyRun()
Dim currentMonth As String
Dim lastRunMonth As String
currentMonth = Format(Date, "yyyy-mm")
' Get last run month from registry: HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ALERTE_BVM\EmailAlert string: LastRunMonth = "2025-04"
On Error Resume Next
lastRunMonth = GetSetting("ALERTE_BVM", "EmailAlert", "LastRunMonth", "")
On Error GoTo 0
' Exit if already run this month
If lastRunMonth = currentMonth Then Exit Sub
' >>> Run your actual logic here <<<
Email_Alert_BVM_Send
' Save the current month so it doesn't run again
SaveSetting "ALERTE_BVM", "EmailAlert", "LastRunMonth", currentMonth
End Sub |
Main code of Email_Alert_BVM_Send:
"send mail.exe" is an executable created in AutoHotkey. Please see code at the bottom of this post.
' #### added AUG 2026 - too long e-mail
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
' #### added AUG 2026 - end
Sub Email_Alert_BVM_Send()
Dim emailTo, emailCC As String
Dim filePath, sendMail As String ' cel mai bine ar fi sa fie LOCAL, pe laptop Daniel, intr-un folder care nu e cu share in OneDrive
filePath = "\\SERVER_PATH_GOES_HERE\EXCEL_FILE_WITH_RULES_SHOWING_ALERT_IN_COLUMN_N.xlsx"
sendMail = "FOLDER_ON_USER_PC_AND_NOT_ON_SERVER\send mail.exe"
emailTo = "EMAIL_ADDRESS_HERE" 'user sends e-mail to himself
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim subject, body, tmpBody As String
Dim mailtoLink As String
Set wb = Workbooks.Open(filePath, ReadOnly:=True)
Set ws = wb.Sheets(1) ' ia primul sheet dupa "code name" (Sheet1), nu dupa denumirea "prietenoasa" (EMM) care poate fi schimbata oricand de user
lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
Dim counter As Long
counter = Application.WorksheetFunction.CountIf(ws.Range("N3:N" & lastRow), "ALERT")
For i = 3 To lastRow
alert = ws.Cells(i, "N").Value
If alert = "ALERT" Then
tmpBody = tmpBody & "- " & ws.Cells(i, "B").Value & " = " & ws.Cells(i, "C").Value & ", seria " & ws.Cells(i, "E").Value
If counter > 1 Then
tmpBody = tmpBody & vbCrLf
End If
End If
Next i
' Creare subiect si corp e-mail
subject = "BVM care expira in luna in curs"
tmpBody = "BVM care expira in luna " & Format(Date, "mmmm") & " " & Format(Date, "yyyy") & " sunt:" & vbCrLf & _
tmpBody
body = tmpBody
' Encode line breaks and spaces
subject = Replace(subject, " ", "%20")
body = Replace(body, vbCrLf, "%0D%0A")
body = Replace(body, " ", "%20")
' Email
mailtoLink = "mailto:" & emailTo & "?subject=" & subject & "&body=" & body
' Launch default email client
'ThisWorkbook.FollowHyperlink mailtoLink ' this did not work for longer e-mails
' #### added AUG 2026 - too long e-mail
ShellExecute 0&, "open", mailtoLink, vbNullString, vbNullString, 1
' #### added AUG 2026 - end
' Inchide fisier excel fara a salva
Application.DisplayAlerts = False
wb.Close savechanges:=False
Application.DisplayAlerts = True
' Wait a moment for New Outlook to bring the draft into focus
Application.Wait Now + TimeValue("0:00:03") 'adjust if needed
' Activare programel de trimitere e-mail (exe facut in AutoHotkey care apasa butonul Send din New Outlook)
Shell """" & sendMail & """", vbNormalFocus
End Sub |
AutoHotkey code to compile "send mail.exe"
Compile with AutoHotkey compiler Ahk2Exe (included in the portable version of AHK).
SetTitleMatchMode, 2 ; Allows partial match in window title
If WinExist("BVM")
{
WinActivate
WinWaitActive, BVM, , 3 ; Wait up to 3 seconds for it to become active
if WinActive("BVM")
{
Sleep, 1000
Send, ^{Enter} ; Ctrl+Enter to send
}
else
{
MsgBox, Email window found but could not be activated.
}
}
else
{
MsgBox, Email window with title containing 'BVM' not found.
} |
There are 2 ways to run this:
1. RoboIntern (free portable sofware) - the simpler way
2. Task Scheduler - requires additional files (1 x BAT file + 1 VBS file) VBS is being deprecated so I'll have to find .JS alternative.
1. RoboIntern - the simpler way
Download RoboIntern and extract to the desired folder.
Set to run on computer startup.
Add Task
ACTIONS tab
Add action - Runn Office VBA Macro - Run Excel macro
Add description, browse the file path to the ALERTE_MAIL.xlsm
In Macro field add: MonthlyRun
TRIGGERS tab
Add trigger - Computer state changes - At computer startup
OPTIONS tab
Execute actions - enabled
Task scheduling - enabled
Delay actions - 180 seconds
Activate scheduling - date when this should start
2. Task Scheduler
This requires additional files, namely a .bat and a .vbs file.
The .bat file runs the .vbs file which calls the macro in the ALERTE_EMAIL.xlsm file. This is the setup required for Task Scheduler. I don't know of another reliable way at the moment.
BAT file:
cscript "LOCAL_PATH_TO_VBS_FILE\BVM_VBS.vbs" "LOCAL_PATH_TO_ALERTE_MAIL\ALERTE_MAIL.xlsm"
exit |
VBS file - runs the MonthlyRun macro in the excel file:
Dim args, objExcel
Set args = WScript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open args(0)
objExcel.Visible = False
objExcel.Run "MonthlyRun"
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close(0)
objExcel.Quit |
Open Task Scheduler (taskschd.msc) and add a new task, add name and description.
TRIGGERS tab:
Code:
New
Begin the task: At log on
Specific user: the local user (should be preselected)
Delay task for: 2 minutes
Enabled: checked
OK |
ACTIONS tab:
Code:
New
Action: Start a program
Program/script: cmd
Add arguments: /c start "RED ALERT" /min "PATH_TO_THE_BAT_FILE\BVM_BAT.bat"
OK |
CONDITIONS tab:
Code:
Stop if the computer switches to battery power unchecked
Start the task only when the computer is on AC power unchecked
Wake the computer to run this task checked |
SETTINGS tab:
Code:
Allow task to be run on demand checked
Run task as soon as possible after a scheduled start is missed checked
Stop the task if it runs longer than unchecked
If the running task does not end when requested, force it to stop checked |
GENERAL tab:
Code:
Run only when user is logged on checked |
OK
|
|
