The process involves sending in an email with the required details, and the script updates the account with the changes. It will only allow users to update their own account (the security of this would be on the assumption that users use authentication to send messages and that it will only action of the FROM and TO are equal). The script will send a confirmation email back to the user detailing the action taken or any errors it encounters (allowing the user to review and resend).
WHAT IT DOES
A successful setting will result in an email, for example:
Administrators can track all submissions (successful or in error) as they are logged in the Hmailserver_events.log. So if someone has a query or complaint in can be found and analysed.Date: Mon, 23 Nov 2015 00:30:42 +0100
To: barry@domain.com
From: barry@domain.com
Subject: Vacation Message Modified.
Auto Reply Message set. Settings set as:
Start Date: 2015-12-11
Expiry Date: 2015-12-20
Message Set To Expire: True
Vacation Message is Enabled: True
[Subject]:
On holiday
[Message]:
Hello.
I am now out of office until 20th December.
Kind regards
---------------------------------
HOW TO USE
1, Create/compose a new PLAIN TEXT email. It must NOT be formatted as only rich text/html, therefore must be sent as, or to include, PLAIN TEXT format (the email will be returned if not).
2, The RECIPIENT must be themselves at the same email address they are sending from (and do not use an alias).
3, The SUBJECT must be whatever Admin has set as the Trigger Subject text - the default is "set vacation") and is not case sensitive.
4, The BODY of the email must be of the following format:
(blank lines between sections are ignored and that the sections can appear in any order. Also, section [labels] are also not case sensitive).[ENABLE]
yes or no
[STARTDATE]
yyyy-mm-dd
[EXPIRY]
yyyy-mm-dd
[SUBJECT]
Email auto-reply Subject text
[MESSAGE]
Lines of email auto-reply message.
Another line of message
Regards
Barry
TIP: Place a pre-formatted email in the TEMPLATES folder of each user (if your email client has them).
To SET the auto-reply:
Fill out all 5 sections and set [ENABLE] as "yes".
Note that the DATES MUST BE VALID. eg, Dont enter 2016-02-30 as there is NEVER a 30th February!
To CANCEL the current auto-reply settings and remove all future scheduled autoreply messages:
set [ENABLE] to be "no". (Note that all other sections may be left uncompleted if cancelling.) NOTE: Cancelling with 'Enabled=no' will remove future scheduled messages too.
Example of user 'Barry' setting his auto-reply:
Example of user 'Barry' CANCELLING his auto-reply:(from: barry@domain.com)
to: barry@domain.com
subject: set vacation
[ENABLE]
yes
[STARTDATE]
2015-12-11
[EXPIRY]
2015-12-20
[SUBJECT]
Out Of Office
[MESSAGE]
Hello. Thank you for your email.
I am currently out of office now until 22nd December. Please contact Vera in my absence.
Thanks
Barry
(Remember that when CANCELLING, all other sections (in grey above) are ignored or can simply be omitted or left in, as you wish).(from: barry@domain.com)
to: barry@domain.com
subject: set vacation
[ENABLE]
no
[STARTDATE]
2015-12-11
[EXPIRY]
2015-12-20
[SUBJECT]
Out Of Office
[MESSAGE]
Hello. Thank you for your email.
I am currently out of office now until 22nd December. Please contact Vera in my absence.
Thanks
Barry
HOW TO IMPLEMENT
5 steps - Easy peazy!.....
There are 2 scripts. I have listed them below (for copy/paste ease) but also they are attached to this post in the file "UserScheduledVacation.zip" if you wish to take them that way. In the zip, the eventhandlers script is called "AppendEventHandlers.vbs". Whatever your choice, then follow these 5 steps:
1, Copy and paste the FIRST script in its entirety in to the bottom of EVENTHANDLERS.VBS script (following normal hmailserver 'script enabling procedure')
2, You must then change 3 variables at the top of the script:
- a, your Administrator password ("HMPassword=")
b, (optional) Your chosen word/phrase as your action Trigger Subject ("TriggerSubject=") - currently set as "set vacation" by default and
c, choice of including the original email subject to your Auto-reply subject (IncludeSubject="NO" - change to "YES" to append). See this recommended rule viewtopic.php?f=21&t=29038 for reasons to consider this option.
Code: Select all
Sub OnAcceptMessage(oClient, oMessage)
OutOfOffice oMessage, oClient
End Sub
- a, your Administrator password at the top of the script ("HMPassword= ")
b, the choice of including the original email subject to your Auto-reply subject (IncludeSubject="NO" - change to "YES" to append)
c, OfficeHoursStartTime on line 4
NOTE: Ideally you would call this script to activate after the previous days office hours to catch all emails that come in since the user went home.
- eg, Users finish at 18:00 and is on holiday from tomorrow. All emails coming in from 18:01 should be auto-responded to as part of that absent period.
If your business does not operate a regular office hours that suits all users then you schedule the script to be called in the early hours (after midnight) and BEFORE normal working office hours in order to set the Autoreply messages in effect for the start of that working day.
In Task Scheduler you simply call:
- Action: "START A PROGRAM"
program/script: "c:\pathto\ScheduledOutOfOffice.vbs"
It should be noted that these scripts store the scheduled messages in a file called "ScheduledOutOfOffice.txt" and is stored in the ROOT of the data directory. DO NOT DELETE it (or you will lose all scheduled entries).
The code (click 'SELECT ALL' and copy/paste):
for EVENTHANDLERS.VBS
Code: Select all
Sub OutOfOffice(oMessage,oClient)
Dim HMPassword, IncludeSubject, SubjSuffix, TriggerSubject, TempTxt
HMPassword = "secretpassword"
TriggerSubject = "set vacation"
IncludeSubject = "NO" ' Change to "YES" to append original subject text to reply subject
Dim obApp, objFSO, PathStore
Set obApp = CreateObject("hMailServer.Application")
Call obApp.Authenticate("Administrator", HMPassword )
PathStore = obApp.Settings.Directories.DataDirectory
If lcase(IncludeSubject) = "yes" then SubjSuffix = " - %SUBJECT%"
If InStr(1, oMessage.To, oMessage.fromaddress, 1) > 0 and oMessage.Recipients(0).IsLocalUser = true and trim(lcase(oMessage.subject))=trim(lcase(TriggerSubject)) and oClient.Username <> "" then
if not oMessage.body = "" then
StartDateOn = "no"
SubjectOn = "no"
MessageOn = "no"
ExpiryOn = "no"
EnableOn = "no"
StartDateErrText = "[STARTDATE] section missing"
StartDateErr = "yes"
SubjectErrText = "[SUBJECT] section missing"
SubjectErr = "yes"
MessageErrText = "[MESSAGE] section missing"
MessageErr = "yes"
ExpiryErrText = "[EXPIRY] section missing"
ExpiryErr = "yes"
EnableErrText = "[ENABLE] section missing"
EnableErr = "yes"
GeneralErr = "no"
Dim CreateGUIDval, obUtilities
Set obUtilities = CreateObject("hMailServer.Utilities")
ScheduleFile = PathStore & "\" & "ScheduledOutOfOffice.txt"
TempParamFile = PathStore & "\" & Mid(obUtilities.GenerateGUID, 2, 36) & ".txt"
TempSchedFile = PathStore & "\" & Mid(obUtilities.GenerateGUID, 2, 36) & ".txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(TempParamFile, 2, true)
objTextFile.WriteLine(oMessage.body)
objTextFile.Close
Dim VacationStartDate
Dim VacationSubjectText
Dim VacationMessageText
Dim VacationExpiryDate
count = 0
Set oRead = objFSO.OpenTextFile(TempParamFile, 1)
Do Until oRead.AtEndOfStream
MessageInputLine = oRead.ReadLine
count = count + 1
if trim(ucase(MessageInputLine))="[STARTDATE]" or trim(ucase(MessageInputLine))="[EXPIRY]" or trim(ucase(MessageInputLine))="[SUBJECT]" _
or trim(ucase(MessageInputLine)) = "[MESSAGE]" or trim(ucase(MessageInputLine))="[ENABLE]" then
if trim(ucase(MessageInputLine)) = "[STARTDATE]" then
if not StartDateOn = "no" then
StartDateErrText = "Duplication [STARTDATE] header entry - Line=" & count
StartDateErr = "yes"
StartDateOn = "done"
else
StartDateOn = "yes"
StartDateErrText = "Missing or invalid STARTDATE parameter (VALID date required). - Line=" & count
End if
if EnableOn = "yes" then EnableOn = "done"
if SubjectOn = "yes" then SubjectOn = "done"
if MessageOn = "yes" then MessageOn = "done"
if ExpiryOn = "yes" then ExpiryOn = "done"
End if
if trim(ucase(MessageInputLine)) = "[ENABLE]" then
if not EnableOn = "no" then
EnableErrText = "Duplication [ENABLE] header entry - Line=" & count
EnableErr = "yes"
EnableOn = "done"
else
EnableOn = "yes"
EnableErrText = "Missing or invalid ENABLE parameter (YES or NO required). - Line=" & count
End if
if StartDateOn = "yes" then StartDateOn = "done"
if SubjectOn = "yes" then SubjectOn = "done"
if MessageOn = "yes" then MessageOn = "done"
if ExpiryOn = "yes" then ExpiryOn = "done"
End if
if trim(ucase(MessageInputLine)) = "[SUBJECT]" then
if not SubjectOn = "no" then
SubjectErrText = "Duplication [SUBJECT] header entry - Line=" & count
SubjectErr = "yes"
SubjectOn = "done"
else
SubjectOn = "yes"
SubjectErrText = "Missing or invalid Subject for Out Of Office message - Line=" & count
End if
if StartDateOn = "yes" then StartDateOn = "done"
if MessageOn = "yes" then MessageOn = "done"
if ExpiryOn = "yes" then ExpiryOn = "done"
if EnableOn = "yes" then EnableOn = "done"
End if
if trim(ucase(MessageInputLine)) = "[EXPIRY]" then
if not ExpiryOn = "no" then
ExpiryErrText = "Duplicate [EXPIRY] entry - Line=" & count
ExpiryErr = "yes"
ExpiryOn = "done"
else
ExpiryOn = "yes"
ExpiryErrText = "Missing or invalid Expiry Date - Line=" & count
End if
if StartDateOn = "yes" then StartDateOn = "done"
if MessageOn = "yes" then MessageOn = "done"
if SubjectOn = "yes" then SubjectOn = "done"
if EnableOn = "yes" then EnableOn = "done"
End If
if trim(ucase(MessageInputLine)) = "[MESSAGE]" then
if not MessageOn = "no" then
MessageErrText = "Duplicate [MESSAGE] entry - Line=" & count
MessageErr = "yes"
MessageOn = "done"
else
MessageOn = "yes"
MessageErrText = "Missing 'Message' details"
End if
End if
else
if StartDateOn = "yes" or SubjectOn = "yes" or ExpiryOn = "yes" or MessageOn = "yes" or EnableOn = "yes" then
if StartDateOn = "yes" then
If not MessageInputLine = "" then
MessageInputLine = replace(trim(MessageInputLine), " ","-")
VacationStartDate = replace(trim(MessageInputLine), ".","-")
if IsNumeric(mid(VacationStartDate,1,4)) = false or IsNumeric(mid(VacationStartDate,6,2)) = false or _
IsNumeric(mid(VacationStartDate,9,2)) = false or isdate(VacationStartDate) = false or len(VacationStartDate) <> 10 then
StartDateErrText = "INVALID START DATE. Date doesnt exist or wrong format (requires yyyy-mm-dd) - " & VacationStartDate
StartDateErr = "yes"
else
if DateDiff("d", VacationStartDate, Now()) > 0 then ' Start in the the past
StartDateErrText = "START DATE set to past date. Start Date must be today or in the future. - " & VacationStartDate
StartDateErr = "yes"
else
StartDateErrText = ""
StartDateErr = "no"
End If
End if
StartDateOn = "done"
End if
End if
if EnableOn = "yes" then
If trim(lcase(MessageInputLine)) = "yes" or trim(lcase(MessageInputLine)) = "no" then
EnableFlag = MessageInputLine
EnableErrText = ""
EnableErr = "no"
End if
EnableOn = "done"
End if
if SubjectOn = "yes" then
If not MessageInputLine = "" then
VacationSubjectText = MessageInputLine
SubjectErrText = ""
SubjectErr = "no"
End if
SubjectOn = "done"
End if
if ExpiryOn = "yes" then
If not MessageInputLine = "" then
MessageInputLine = replace(trim(MessageInputLine), " ","-")
VacationExpiryDate = replace(trim(MessageInputLine), ".","-")
if IsNumeric(mid(VacationExpiryDate,1,4)) = false or IsNumeric(mid(VacationExpiryDate,6,2)) = false or _
IsNumeric(mid(VacationExpiryDate,9,2)) = false or isdate(VacationExpiryDate) = false or len(VacationExpiryDate) <> 10 then
ExpiryErrText = "INVALID EXPIRY DATE. Date doesnt exist or wrong format (requires yyyy-mm-dd) - " & VacationExpiryDate
ExpiryErr = "yes"
else
if DateDiff("d", VacationExpiryDate, Now()) >= 0 then ' Expiry in the past
ExpiryErrText = "EXPIRY DATE set to past date. Expiry Date must be in the future."
ExpiryErr = "yes"
else
ExpiryErrText = ""
ExpiryErr = "no"
End If
End if
ExpiryOn = "done"
End if
End if
if MessageOn = "yes" then
If MessageInputLine = "" then
VacationMessageText = VacationMessageText & vbNewLine
Else
VacationMessageText = VacationMessageText & MessageInputLine & vbNewLine
MessageErrText = ""
MessageErr = "no"
End If
End if
else
if not MessageInputLine = "" then
GeneralErrText = "Text out of valid section - Line=" & count & ". Line text='" & MessageInputLine &"'"
GeneralErr = "yes"
End if
End if
End if
Loop
if len(VacationMessageText) > 1000 then
MessageErrText = "[MESSAGE] text too long. Maximum 1000 characters allowed (including <newline> and trailing blank lines). Current message has " _
& len(VacationMessageText) & " characters."
MessageErr = "yes"
End if
oRead.Close() ' Close input file
objFSO.DeleteFile TempParamFile
if ExpiryErr = "no" and StartDateErr = "no" then
if DateDiff("d", VacationStartDate, VacationExpiryDate) < 0 then ' Start beyond Expiry date
StartDateErrText = "EXPIRY DATE set before START DATE. Start Date must be before expiry date."
StartDateErr = "yes"
End if
End if
else
SubjectErrText = "Out Of Office Configuration emails must be in PLAIN text format. Please resend as plain text."
MessageErrText = ""
End if
if EnableErr = "yes" or ( ( StartDateErr = "yes" or SubjectErr = "yes" or MessageErr = "yes" or ExpiryErr = "yes" or GeneralErr = "yes" ) _
and EnableFlag = "yes") then
eventlog.write(now() & " User Submitted AutoReply - FAILED: User:" & oMessage.fromaddress )
if StartDateErrText <> "" then eventlog.write( "Start Date Error= " & StartDateErrText )
if ExpiryErrText <> "" then eventlog.write( "Expiry Date Error= " & ExpiryErrText )
if SubjectErrText <> "" then eventlog.write( "Subject Error= " & SubjectErrText )
if EnableErrText <> "" then eventlog.write( "Enable Error=" & EnableErrText )
if GeneralErrText <> "" then eventlog.write( "General Error=" & GeneralErrText )
if MessageErrText <> "" then eventlog.write( "Message Error=" & MessageErrText )
oMessage.subject = "Vacation Message Failed - not set due to errors shown."
if StartDateErrText <> "" then TempTxt = TempTxt & "Start Date Error= " & StartDateErrText & vbNewLine & vbNewLine
if SubjectErrText <> "" then TempTxt = TempTxt & "Subject Error= " & SubjectErrText & vbNewLine & vbNewLine
if EnableErrText <> "" then TempTxt = TempTxt & "Enable Error=" & EnableErrText & vbNewLine
if MessageErrText <> "" then TempTxt = TempTxt & "Message Error= " & MessageErrText & vbNewLine & vbNewLine
if ExpiryErrText <> "" then TempTxt = TempTxt & "Expiry Date Error= " & ExpiryErrText & vbNewLine & vbNewLine
if GeneralErrText <> "" then TempTxt = TempTxt & "General Error=" & GeneralErrText & vbNewLine & vbNewLine
oMessage.body = TempTxt & "Format should contain sections in any order as follows:" & vbNewLine & _
"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^" & vbNewLine & _
"[STARTDATE]" & vbNewLine & _
"yyyy--mm-dd (*Ensure its a VALID date and not in the past!)" & vbNewLine & vbNewLine & _
"[ENABLE]" & vbNewLine & _
"YES (to set auto-reply with the details below) or NO (to cancel auto-reply messages)" & vbNewLine & vbNewLine & _
"[EXPIRY]" & vbNewLine & _
"yyyy--mm-dd (*Ensure its a VALID date!)" & vbNewLine & vbNewLine & _
"[SUBJECT]" & vbNewLine & _
"Out Of Office subject text" & vbNewLine & vbNewLine & _
"[MESSAGE]" & vbNewLine & _
"Lines of email message1" & vbNewLine & _
"Lines of email message2" & vbNewLine & _
"Lines of email message3" & vbNewLine & _
"etc" & vbNewLine & vbNewLine & _
"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^" & vbNewLine & vbNewLine & "Original Email ------------------------------" & _
vbNewLine & oMessage.body & "End of Original email ------------------------------"
oMessage.htmlbody = Replace(oMessage.body, Chr(13), "<br>")
oMessage.save
Else
eventlog.write(now() & " User Submitted AutoReply: User:" & oMessage.fromaddress & ", Enable: " & ucase(EnableFlag) & ", Dates from/to: " _
& VacationStartDate & " - " & VacationExpiryDate)
aUsername = Split(oMessage.fromaddress,"@")
Dim obDomain
Set obDomain = obApp.Domains.ItemByName(aUsername(1))
Dim obAccount
Set obAccount = obDomain.Accounts.ItemByAddress(oMessage.fromaddress)
if trim(lcase(EnableFlag)) = "yes" then
if DateDiff("d", VacationStartDate, Now()) < 0 then ' Start in the future so write to file
Set oScRead = OpenMyFile(ScheduleFile,8)
oScRead.WriteLine("[ACCOUNT]" & trim(lcase(oMessage.fromaddress)))
oScRead.WriteLine("[STARTDT]" & trim(VacationStartDate))
oScRead.WriteLine("[EXPIRY ]" & trim(VacationExpiryDate))
oScRead.WriteLine("[SUBJECT]" & trim(VacationSubjectText))
oScRead.WriteLine("[MESSAGE]" & trim(VacationMessageText))
oScRead.Close() ' Close input file
oMessage.body = "Auto Reply Message set for FUTURE ACTIVATION. Settings set as:" & vbNewLine & vbNewLine & "Start Date: " & VacationStartDate _
& vbNewLine & "Expiry Date: " & VacationExpiryDate & vbNewLine & "Message Set To Expire: " & "True" & vbNewLine & _
"Vacation Message is Enabled: " & "Future" & vbNewLine & vbNewLine & "[Subject]:" & vbNewLine & VacationSubjectText & _
vbNewLine & "[Message]:" & vbNewLine & VacationMessageText & vbNewLine & "---------------------------------"
oMessage.subject = "Future Vacation Message Set."
oMessage.htmlbody = Replace(oMessage.body, Chr(13), "<br>")
else ' update database as start date is today or past
obAccount.VacationSubject = VacationSubjectText
obAccount.VacationMessage = VacationMessageText
obAccount.VacationMessageExpiresDate = VacationExpiryDate
obAccount.VacationMessageExpires = True
obAccount.VacationMessageIsOn = True
oMessage.body = "Auto Reply Message set. Settings received and set as follows:" & vbNewLine & vbNewLine & "Expiry Date: " & _
obAccount.VacationMessageExpiresDate & vbNewLine & "Message Set To Expire: " & obAccount.VacationMessageExpires & vbNewLine & _
"Vacation Message is Enabled: " & obAccount.VacationMessageIsOn & vbNewLine & vbNewLine & "[Subject]:" & vbNewLine & obAccount.VacationSubject & _
vbNewLine & "[Message]:" & vbNewLine & obAccount.VacationMessage & vbNewLine & "---------------------------------"
oMessage.htmlbody = Replace(oMessage.body, Chr(13), "<br>")
oMessage.subject = "Vacation Message Modified."
obAccount.VacationSubject = obAccount.VacationSubject & SubjSuffix
End if
else
Set oSchedFile = objFSO.OpenTextFile(TempSchedFile, 2, true)
Set oSchedRead = OpenMyFile(ScheduleFile,1)
Do Until oSchedRead.AtEndOfStream
SchedInputLine = oSchedRead.ReadLine
if left(ucase(SchedInputLine),9) = "[ACCOUNT]" then
if SchedInputLine = "[ACCOUNT]" & oMessage.fromaddress then
CancelSched = "yes"
Else
CancelSched = "no"
End if
End if
if CancelSched = "no" then
oSchedFile.WriteLine(SchedInputLine)
End if
Loop
oSchedRead.Close() ' Close input file
oSchedFile.Close()
objFSO.DeleteFile ScheduleFile
objFSO.MoveFile (TempSchedFile), (ScheduleFile)
obAccount.VacationMessageIsOn = False
oMessage.body = "Auto Reply Message CANCELLED including all scheduled future settings. Settings with ""ENABLE=NO"" was sent." & vbNewLine & vbNewLine & "Hmailserver Admin."
oMessage.htmlbody = Replace(oMessage.body, Chr(13), "<br>")
oMessage.subject = "Vacation Message Cancelled."
End if
obAccount.Save
oMessage.save
End if ' End if email = set out of office
End if
End Sub
Function WaitTimer(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True
End With
End Function
Function OpenMyFile(strPath, ioMode)
With CreateObject("Scripting.FileSystemObject")
Dim oFile, i
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, ioMode, True)
If (Not Err.Number = 70) Then
Set OpenMyFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
WaitTimer(1)
Next
End With
Set oFile = Nothing
If (Err.Number = 70) Then
EventLog.Write("ERROR: VBScript Function OpenMyFile")
EventLog.Write("File " & strPath & " is locked and timeout was exceeded.")
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write("ERROR: VBScript Function OpenMyFile")
EventLog.Write("Error : " & Err.Number)
EventLog.Write("Error (hex) : 0x" & Hex(Err.Number))
EventLog.Write("Source : " & Err.Source)
EventLog.Write("Description : " & Err.Description)
Err.Clear
End If
End Function
Code: Select all
Dim HMPassword, Pathstore, TempOutFile, ScheduleFile, IncludeSubject, SubjSuffix, OfficeHoursStartTime
HMPassword = "secretpassword"
IncludeSubject = "YES" ' "YES" to append original subject text to auto-reply subject
OfficeHoursStartTime = "08:00"
Dim VacationSubjectText
Dim VacationMessageText
Dim VacationExpiryDate
Dim VacationAccount
Dim CreateGUIDval, obUtilities, process, TempAccount, diffcheck
Dim obApp, objFSO, EventLog
Set obApp = CreateObject("hMailServer.Application")
Call obApp.Authenticate("Administrator", HMPassword )
Set EventLog = CreateObject("hMailServer.eventlog")
PathStore = obApp.Settings.Directories.DataDirectory
If lcase(IncludeSubject) = "yes" then SubjSuffix = " - %SUBJECT%"
If time > timevalue(OfficeHoursStartTime) then diffcheck = -1
Set obUtilities = CreateObject("hMailServer.Utilities")
Set objFSO = CreateObject("Scripting.FileSystemObject")
TempOutFile = PathStore & "\" & Mid(obUtilities.GenerateGUID, 2, 36) & ".txt"
ScheduleFile = PathStore & "\ScheduledOutOfOffice.txt"
Set objTextFile = objFSO.OpenTextFile(TempOutFile, 2, true)
Set oRead = OpenMyFile(ScheduleFile,1)
VacationAccount = ""
'FORMAT
'[ACCOUNT]user1@domain.com
'[STARTDT]2015-02-07
'[EXPIRY ]2016-02-24
'[SUBJECT]subject text
'[MESSAGE]message text 1
'message text2
'
'End of message
Do Until oRead.AtEndOfStream
MessageInputLine = oRead.ReadLine
if left(ucase(MessageInputLine),9) = "[ACCOUNT]" then
if VacationAccount <> "" then
UpdateDB VacationAccount,VacationExpiryDate,VacationSubjectText,VacationMessageText ' DO THE DATABASE UPDATE
VacationAccount = ""
End if
MessageRead = "off"
VacationMessageText = ""
TempAccount = right(MessageInputLine,len(MessageInputLine)-9)
process="no"
End if
if left(ucase(MessageInputLine),9) = "[STARTDT]" then
StartDate = mid(MessageInputLine,10,10)
if DateDiff("d", StartDate, Now) >= diffcheck then ' Start date in the past
process = "yes"
VacationAccount = TempAccount
else ' start date in the future
objTextFile.WriteLine("[ACCOUNT]" & TempAccount)
End if
End if
if process = "yes" then
if left(ucase(MessageInputLine),9) = "[EXPIRY ]" then
ExpiryDateLine = mid(MessageInputLine,10,10)
if DateDiff("d", ExpiryDateLine, Now) + abs(diffcheck) >= 0 then ' Expiry date in the past
process = "remove"
VacationAccount = ""
else
VacationExpiryDate = right(MessageInputLine,len(MessageInputLine)-9)
End if
End if
if left(ucase(MessageInputLine),9) = "[SUBJECT]" then
VacationSubjectText = right(MessageInputLine,len(MessageInputLine)-9)
End if
if left(ucase(MessageInputLine),9) = "[MESSAGE]" or MessageRead = "on" then
if MessageRead = "off" then
MessageInputLine = replace(MessageInputLine, "[MESSAGE]", "")
VacationMessageText = VacationMessageText & MessageInputLine
MessageRead = "on"
else
VacationMessageText = VacationMessageText & vbNewLine & MessageInputLine
End if
End if
elseif process = "no" then
if left(ucase(MessageInputLine),9) <> "[ACCOUNT]" then
objTextFile.WriteLine(MessageInputLine)
End if
End if
Loop
if VacationAccount <> "" then
UpdateDB VacationAccount,VacationExpiryDate,VacationSubjectText,VacationMessageText' DO THE DATABASE UPDATE
End if
oRead.Close() ' Close input file
objFSO.DeleteFile ScheduleFile
objTextFile.Close()
objFSO.MoveFile (TempOutFile), (ScheduleFile)
Sub UpdateDB(VacationAccount,VacationExpiryDate,VacationSubjectText,VacationMessageText)
if DateDiff("d", StartDate, Now) >= diffcheck and DateDiff("d", ExpiryDateLine, Now) < diffcheck then
aUsername = Split(VacationAccount,"@")
Dim obDomain, obAccount, newMessage, HTMLmessageText
HTMLmessageText= Replace(VacationMessageText, Chr(13), "<br>")
Set newMessage = CreateObject("hMailServer.Message")
newMessage.From = "OutOfOffice Reminder <" & VacationAccount &">"
newMessage.Subject = left(now,10) & " Scheduled Vacation Message activated."
newMessage.Body = "A previously scheduled auto-reply message has been activated for this email address. Details are:" & vbNewLine & vbNewLine & _
"Expires: " & VacationExpiryDate & vbNewLine & vbNewLine & _
"Subject: " & VacationSubjectText & vbNewLine & _
"Message: " & vbNewLine & VacationMessageText
newMessage.htmlBody = Replace(newMessage.Body, Chr(13), "<br>")
newMessage.AddRecipient VacationAccount, VacationAccount
newMessage.save
Set obDomain = obApp.Domains.ItemByName(aUsername(1))
Set obAccount = obDomain.Accounts.ItemByAddress(VacationAccount)
obAccount.VacationSubject = VacationSubjectText & SubjSuffix
obAccount.VacationMessage = VacationMessageText
obAccount.VacationMessageExpiresDate = VacationExpiryDate
obAccount.VacationMessageExpires = True
obAccount.VacationMessageIsOn = True
obAccount.Save
End if
End Sub
Function WaitTimer(sec)
With CreateObject("WScript.Shell")
.Run "timeout /T " & Int(sec), 0, True
End With
End Function
Function OpenMyFile(strPath, ioMode)
With CreateObject("Scripting.FileSystemObject")
Dim oFile, i
For i = 0 To 30
On Error Resume Next
Set oFile = .OpenTextFile(strPath, ioMode, True)
If (Not Err.Number = 70) Then
Set OpenMyFile = oFile
On Error Goto 0
Exit For
End If
On Error Goto 0
WaitTimer(1)
Next
End With
Set oFile = Nothing
If (Err.Number = 70) Then
EventLog.Write("ERROR: VBScript Function OpenMyFile")
EventLog.Write("File " & strPath & " is locked and timeout was exceeded.")
Err.Clear
ElseIf (Err.Number <> 0) Then
EventLog.Write("ERROR: VBScript Function OpenMyFile")
EventLog.Write("Error : " & Err.Number)
EventLog.Write("Error (hex) : 0x" & Hex(Err.Number))
EventLog.Write("Source : " & Err.Source)
EventLog.Write("Description : " & Err.Description)
Err.Clear
End If
End Function
(Version changelog listed below in thread)
Comments appreciated.