Skript pro MS Exchange server

• Zapnout doplněk na podporu skriptování na Exchange serveru. Popis v menu MS OUTLOOK 2000 MOŽNOSTI >> JINÉ >> UPŘESNIT NASTAVENÍ >> SPRÁVCE DOPLŇKŮ >> zaškrtnout SKRIPTOVÁNÍ NA STRANĚ SERVERU
• Vytvořit samostatnou složku, např. RADARY_CZ
• Ve vlastnostech této složky se zobrazí další záložka AGENTI, ve které tlačítkem NOVÝ založíte nového agenta U něj je nutné zaškrtnout PUBLIKOVÁNÍ NOVÉ POLOŽKY V TÉTO SLOŹCE
• Kliknout na tlačítko UPRAVIT SCRIPT, v otevřeném okně vše smazat a vložit skript, která následuje níže.
• V položce sms_brana v textu skriptu na 56. řádku doplnit místo textu e-mail text:
  
  • pro Eurotel 00420602xxxxxx@sms.eurotel.cz ci 00420606xxxxxx@sms.eurotel.cz (za xxxxxx doplňte vaše telefonní číslo bez 0602 či 0606)
  • pro Paegas +420603xxxxxx@sms.paegas.cz ci +420604xxxxxx@sms.paegas.cz (za xxxxxx doplňte vaše telefonní číslo bez 0603 či 0604)
• Uložit a je to

Skript:

<SCRIPT RunAt=Server Language=VBScript>

'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT 
'WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, 
'INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES 
'OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR 
'PURPOSE

'------------------------------------------------------------------------------
'
' NAME: Anonymous
'
' FILE DESCRIPTION: Sends a message to a public folder if a new item has arrived
'                   in the inbox of a particular mailbox.
'
' Copyright (c) CdoLive 1998. All rights reserved.
'               Http://www.cdolive.com
'               Mailto:samples@cdolive.com
'
' Portions:
' Copyright (c) Microsoft Corporation 1993-1997. All rights reserved.
'
'------------------------------------------------------------------------------

Option Explicit

'------------------------------------------------------------------------------
'	Global Variables
'------------------------------------------------------------------------------

Dim g_bstrDebug							' Debug String

'------------------------------------------------------------------------------
'	CONSTANTS
'------------------------------------------------------------------------------

Dim g_Const_PF

g_Const_PF = "Anonymous Postings"				' Display name of the Public Folder

'------------------------------------------------------------------------------
'	EVENT HANDLERS
'------------------------------------------------------------------------------

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

	Dim oSession						' Session
	Dim oAnonymousMsg					' New message
	Dim oCurrentMsg						' Current message
	Dim oFolder						' Current folder
	Dim oFolderOutbox					' Outbox folder
	Dim oRecipient						' Recipient
	Dim sms_brana

	sms_brana = "SMTP:e-mail"

	' Clear error buffer
	Err.Clear

	' Get session informationen
	Set oSession = EventDetails.Session

	' No errors detected ?
	If Err.Number = 0 Then

		' Write some logging
		Call DebugAppend(oSession.CurrentUser & " " & g_Const_PF & " - Proccessing startet", False)

		' Get outbox folder
		Set oFolderOutbox = oSession.Outbox

		' No errors detected ?
		If Err.Number = 0 Then

			' Get current folder
			Set oFolder = oSession.GetFolder(EventDetails.FolderID,Null)

			' No errors detected ?
			If Err.Number = 0 Then

				' Get current message
				Set oCurrentMsg = oSession.GetMessage(EventDetails.MessageID,Null)

				' Error detected ?
				If Not Err.Number = 0 Then

					' Error reading new message
					Call DebugAppend("Error - Could not read message", True)
				Else

					' Remember subject of new message
					Call DebugAppend("New message with subject: <" & oCurrentMsg.Subject & "> arrived", False)

					' Create new message
					'Set oAnonymousMsg = oFolderOutbox.Messages.Add
					Set oAnonymousMsg = oCurrentMsg.Forward()
					
					' No errors detected ?
					If Err.Number = 0 Then

						' Set message class
						'oAnonymousMsg.Type = "IPM.Note.Anonymous"

						' Remember ConversationIndex
						oAnonymousMsg.ConversationIndex = oCurrentMsg.ConversationIndex

						' Set message subject
						'oAnonymousMsg.Subject = oCurrentMsg.Subject

						' Has message a "Re:" in the subject ?
						If Left(UCase(oCurrentMsg.Subject),3) = "RE:" Then

							' Set message subject without the "Re:" in the ConversationTopic
							'oAnonymousMsg.ConversationTopic = LTrim(Mid(oCurrentMsg.Subject,4,255))
						Else

							' Set complete message subject in the ConversationTopic
							'oAnonymousMsg.ConversationTopic = oCurrentMsg.Subject
						End If

						' Set message text
						oAnonymousMsg.Text = oCurrentMsg.Text

						' Set recipient
						Set oRecipient = oAnonymousMsg.Recipients.Add("Radary", sms_brana)
						

						' Resolve recipient against the Exchange Directory
						oRecipient.Resolve

						' Error detected ?
						If Err.Number <> 0 Then

							' Could not resolve recipient, write logging
							Call DebugAppend("Error - Could not resolve recipient: " & g_Const_PF, True)
						Else

							' Sent message
							oAnonymousMsg.Update
							oAnonymousMsg.Send

							' Error detected ?
							If Err.Number <> 0 then

								' Could not sent message, write logging
								Call DebugAppend("Error - Could not sent message", True)
							Else

								' Message successfully sent
								Call DebugAppend("Success - Message sent to: " & g_Const_PF, False)
							End If
						End If
					Else

						' Could not create new message
						Call DebugAppend("Error - Failed to create message", True)
					End If

					' Set current message status to read and delete it
					'oCurrentMsg.Unread = False
					'oCurrentMsg.Delete
				End If
			Else

				' Could not get current folder
				Call DebugAppend("Error - Could not get current folder", True)
			End If
		Else

			' Could not set outbox
			Call DebugAppend("Error - Could not set outbox", True)
		End If
	Else

		' Check for any possible sys errors
		Call DebugAppend("Undefinied Error detected", True)
	End If

	' Check if folder object is set
	If Not oFolder Is Nothing Then

		' Write some logging, including the folder name
		Call DebugAppend(oFolder.Name & " " & g_Const_PF & " - Processing finished", False)
	Else

		' Write some logging, without the folder name
		Call DebugAppend(g_Const_PF & " - Processing finished", False)
	End If

	' Release objects
	Set oSession = Nothing
	Set oFolderOutbox = Nothing
	Set oFolder = Nothing
	Set oCurrentMsg = Nothing
	Set oAnonymousMsg = Nothing
	Set oRecipient = Nothing

	' Write results to the Scripting Agent log
	Script.Response = g_bstrDebug
End Sub

' DESCRIPTION: This event is fired when a message in the folder is changed
Public Sub Message_OnChange
	' Not used
End Sub

' DESCRIPTION: This event is fired when a message is deleted from the folder
Public Sub Folder_OnMessageDeleted
	' Not used
End Sub

' DESCRIPTION: This event is fired when the timer on the folder expires
Public Sub Folder_OnTimer
	' Not used
End Sub

'-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
'                  PRIVATE FUNCTIONS/SUBS
'-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

'------------------------------------------------------------------------------
'   Name: DebugAppend
'   Area: Debug
'   Desc: Simple Debugging Function
'   Parm: String Text, Bool ErrorFlag
'------------------------------------------------------------------------------

Private Sub DebugAppend(bstrParm,boolErrChkFlag)

	If boolErrChkFlag = True Then
		If Err.Number <> 0 Then
			g_bstrDebug = g_bstrDebug & bstrParm & " - " & cstr(Err.Number) & " " & Err.Description & vbCrLf
			Err.Clear
		End If
	Else
		g_bstrDebug = g_bstrDebug & bstrParm & vbCrLf
	End If

End Sub

</SCRIPT>