Move emails to top of the queue based on certain priority header flags

Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
User avatar
SorenR
Senior user
Senior user
Posts: 3668
Joined: 2006-08-21 15:38
Location: Denmark

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-14 13:13

Basic error messaging...
http://www.csidata.com/custserv/onlineh ... vbs241.htm

Code: Select all

Sub ShowError(Event)
    EventLog.Write( "Error ==> " & Event )
    EventLog.Write( "Error Description: " & err.Description )
    EventLog.Write( "Error Source: " & err.Source )
    EventLog.Write( "Error Number: " & err.Number )
    err.Clear
End Sub

Dim oApp, oMail, oFSO, column, Match, Matches, Priority : Priority = False

'
'   Setting up DCOM access
'
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")

'
'   Read queue list and process line by line
'
Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)
For Each Match In Matches
    column = Split( Match, vbTab )
    
    '
    '   Create new temporary email structure and obtain filename
    '
    Set oMail = CreateObject("hMailServer.Message")
    strFilename = oMail.Filename
    
    '
    '   Copy original queued mail into temporary mail structure
    '
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FileExists(column(5)) Then
        err.Clear
        On Error Resume Next
        oFSO.CopyFile column(5), strFilename, True
        On Error GoTo 0
        If err.Number <> 0 Then
            showError("Priority queue handler: column(5) = " & column(5) & " strFilename = " & strFilename)
        Else
            '
            '   Reload temporary mail structure and IF "X-Priority" = 1 THEN update priority in queue
            '
            oMail.RefreshContent
            If oMail.HeaderValue("X-Priority") = "1" Then
                oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
                Priority = True
            End If
            
            '
            '   Delete temporary mail structure
            '
            On Error Resume Next
            oFSO.DeleteFile strFilename, True
            On Error GoTo 0
            If err.Number <> 0 Then showError("Priority queue handler: strFilename = " & strFilename)
        End If
    End If
Next

'
'   Force delivery of prioritized mails.
'
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery

'
'   Housekeeping ;-)
'
Set oApp = Nothing
Set oMail = Nothing
Set oFSO = Nothing
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

cblaze22
Normal user
Normal user
Posts: 185
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-14 17:57

Yes other then that one issue where it oddly didnt find a file, yes.

If you create and copy an object, does that not open something? If it writes a new file to the server, doesnt that keep a handle on it.

User avatar
SorenR
Senior user
Senior user
Posts: 3668
Joined: 2006-08-21 15:38
Location: Denmark

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-14 18:14

cblaze22 wrote:
2020-03-14 17:57
If you create and copy an object, does that not open something? If it writes a new file to the server, doesnt that keep a handle on it.
Nope... You only open a file for reading or writing.
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

cblaze22
Normal user
Normal user
Posts: 185
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-15 22:19

Well got another orphan email. The email looks to have an attachment, so a large file. I am wondering if the copyfile function is not done when the deletefile is hit and it doesnt see the file. The email was 10MB.

Does EventLog.Write work in a task scheduler VBScript? If so does it go into the HMailServer one.

User avatar
SorenR
Senior user
Senior user
Posts: 3668
Joined: 2006-08-21 15:38
Location: Denmark

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-15 23:18

cblaze22 wrote:
2020-03-15 22:19
Well got another orphan email. The email looks to have an attachment, so a large file. I am wondering if the copyfile function is not done when the deletefile is hit and it doesnt see the file. The email was 10MB.

Does EventLog.Write work in a task scheduler VBScript? If so does it go into the HMailServer one.
You are running this from shell and not inside EventHandlers ??
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

User avatar
SorenR
Senior user
Senior user
Posts: 3668
Joined: 2006-08-21 15:38
Location: Denmark

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-15 23:30

EventLog should work when COM/DCOM is authenticated but if not, you should replace...

Code: Select all

Dim oApp, oMail, oFSO, column, Match, Matches, Priority : Priority = False

'
'   Setting up DCOM access
'
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")
with...

Code: Select all

Dim EventLog, oApp, oMail, oFSO, column, Match, Matches, Priority : Priority = False

'
'   Setting up DCOM access
'
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")
Set EventLog = CreateObject("hMailServer.EventLog")
I use EventLog.Write() in some of my code outside EventHandlers.vbs...
SørenR.

“Those who don't know history are doomed to repeat it.”
― Edmund Burke

cblaze22
Normal user
Normal user
Posts: 185
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-16 03:26

I added that new line.

Yes I run it in task scheduler because it checks every minute the queue to resend important emails if the queue is super long.

Post Reply