Traitement de fichiers sur disques et génération d’un message à envoyer

PS : Ne pas oublier de créer un profil exchange par utilisateur autorisé à envoyer par ce biais. Retirer les XXX avant d’inclure dans Exchange.

 

 

< XXXSCRIPT RunAt=Server Language=VBScript>

'------------------------------------------------------------------------------

'FILE DESCRIPTION: Exchange Server Event Script

'------------------------------------------------------------------------------

'Modification

'Option Explicit

'------------------------------------------------------------------------------

' Global Variables

'------------------------------------------------------------------------------

dim AMSession

dim fldrTarget

'------------------------------------------------------------------------------

' Event Handlers

'------------------------------------------------------------------------------

 

' DESCRIPTION: This event is fired when a new message is added to the folder

Public Sub Folder_OnMessageCreated

            set AMSession = EventDetails.Session

            idTargetFolder = EventDetails.FolderID

            Set fldrTarget = AMSession.GetFolder( idTargetFolder, Null )

            call send_files()

End Sub

 

' DESCRIPTION: This event is fired when a message in the folder is changed

Public Sub Message_OnChange

            set AMSession = EventDetails.Session

            idTargetFolder = EventDetails.FolderID

            Set fldrTarget = AMSession.GetFolder( idTargetFolder, Null )

            call send_files()

End Sub

 

' DESCRIPTION: This event is fired when a message is deleted from the folder

Public Sub Folder_OnMessageDeleted

            set AMSession = EventDetails.Session

            idTargetFolder = EventDetails.FolderID

            Set fldrTarget = AMSession.GetFolder( idTargetFolder, Null )

            call send_files()

End Sub

 

' DESCRIPTION: This event is fired when the timer on the folder expires

Public Sub Folder_OnTimer()

            set AMSession = EventDetails.Session

            idTargetFolder = EventDetails.FolderID

            Set fldrTarget = AMSession.GetFolder( idTargetFolder, Null )

            call send_files()

End Sub

 

Public Function Send_Files()

 

Dim fsysfolder

 

On Error Resume Next

 

        dbg = False

        ownMbox = False

        If dbg Then

            'Dim amsession 'As Session

            'Dim TargetFolder 'As Folder

            fsysfolder = "E:\Echanges\sortie"

'            Set amsession = New Session

            amsession.Logon "admexchange"

            Set pubfold = amsession.InfoStores("Dossiers publics")

            Set TargetFolder = pubfold.RootFolder.Folders("Tous").Folders("Applications").Folders("Echanges").Folders("Sortie")

            idTargetFolder = TargetFolder.ID

            Set fldrTarget = amsession.GetFolder(idTargetFolder, Null)

        Else

            fsysfolder = "E:\Echanges\sortie"

        End If

      

 

Set fsys = CreateObject("scripting.FileSystemObject")

Set EntFolder = fsys.GetFolder(fsysfolder)

 

For Each f In EntFolder.Files

    Set r = fsys.OpenTextFile(f, 1, False)

    'Do While r.AtEndOfStream <> True

        emetteur = r.readLine

        destinataires = r.readLine

        sujet = r.readLine

        repertoire = r.readLine

        Texte = r.readAll

    r.Close

    'Dim NewSession As Session

    If ownMbox Then

        Set NewSession = CreateObject("MAPI.Session")

        NewSession.Logon emetteur

        Set Outbox = NewSession.Outbox

        If Not dbg Then Script.response = fldrTarget.Name

            Set mtmp = Outbox.Messages.Add

            Set m = Outbox.Messages.Add

    'Set mtmp = AMSession.outbox.Messages.Add

    'Set m = AMSession.outbox.Messages.Add

    Else

            Set mtmp = fldrTarget.Messages.Add

            Set m = fldrTarget.Messages.Add

    End If

    m.Subject = sujet

    m.Text = Texte

    'm.Update

    Set oSender = mtmp.Recipients.Add

    oSender.Name = emetteur

    oSender.Resolve

    m.Sender = oSender.AddressEntry

    Start = 1

    pos = 1

    While pos

    pos = InStr(Start, destinataires, ";")

    If pos <> 0 Then

        strdest = Left(destinataires, pos - 1)

        destinataires = Right(destinataires, Len(destinataires) - pos)

        Set dest = m.Recipients.Add

        dest.Name = strdest

        dest.Resolve

    End If

   

    Wend

 

    If Len(repertoire) > 0 Then

    Set AtFolder = fsys.GetFolder(fsysfolder & "\" & repertoire)

    For Each attach In AtFolder.Files

        Set att = m.Attachments.Add

            att.Type = 1 'cdoFile

            att.Position = Len(Texte) + 1 ' render at first character of message

            att.Name = attach.Name

            att.Source = attach

            'att.ReadFromFile attach

            If Not dbg Then attach.Delete

           

    Next

    If Not dbg Then AtFolder.Delete

    End If

    'm.Update

    Set fldrArch = fldrTarget.Folders("Archive")

    Set c = m.CopyTo(fldrArch.ID, Null)

    c.Sent = True

    c.TimeSent = Now()

    c.Update

    c.Send

   

    m.Sent = False

    m.Unread = True

    m.Submitted = True

    m.Update

    c.Send

 

    If Not dbg Then f.Delete

    If ownMbox Then

        NewSession.Close

        Set NewSession = Nothing

    End If

Next

 

End Function

</XXXSCRIPT>