So you want custom programming assistance? I'm sure a lot of people will do that for you for T&M.
Ed Crowley MCSE+Internet MVP kcCC+I Tech Consultant hp Services Protecting the world from PSTs and Bricked Backups! -----Original Message----- From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]] On Behalf Of [EMAIL PROTECTED] Sent: Wednesday, August 07, 2002 3:44 PM To: Exchange Discussions Subject: Automatic Message Responding Script tweak help I am using the one from CDOLive.com. It works great, but every automatic reply creates and entry in the 'Sent Items' folder. Anyone know how to tweak this script to fix it? Thanks in advance. (script is below) <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: AutoReply ' ' FILE DESCRIPTION: Automatically replies to all incomming messages with a ' predefined text. Messages that contain status information ' (e.g. delivery reports) are detected and omitted. ' ' Copyright (c) CdoLive 1999. All rights reserved. ' Http://www.cdolive.com ' Mailto:[EMAIL PROTECTED] ' ' Portions: ' Copyright (c) Microsoft Corporation 1993-1997. All rights reserved. ' '----------------------------------------------------------------------- ------- Option Explicit '----------------------------------------------------------------------- ------- ' Global Variables '----------------------------------------------------------------------- ------- Dim g_bstrDebug ' Debug String '----------------------------------------------------------------------- ------- ' CONSTANTS '----------------------------------------------------------------------- ------- ' MAPI property tags used in this script Const CdoPR_ACTION = &H10800003 Const CdoPR_ACTION_FLAG = &H10810003 Const CdoPR_ACTION_DATE = &H10820040 Const CdoPR_AUTO_FORWARDED = &H0005000B Const CdoPR_SENT_REPRESENTING_ADDRTYPE = &H0064001E Const ACTION_REPLY = 261 Const ACTION_FORWARD = 262 Const ACTION_REPLY_SENDER = 102 Const ACTION_REPLY_ALL = 103 Const ACTION_FORWARD_FORWARD = 104 ' Reply text file Dim g_Const_ReplyText 'Auto reply message text g_Const_ReplyText = "Thank you for your interest in the Woodland Park Zoological Society." & Chr(13) & Chr(13) &_ "Due to the large volume of resumes we receive, we regret that we are unable to respond to everyone personally. If you have submitted a resume for an open position, we will carefully review your background and qualifications. If we determine your combination of skills and experience match any of our current openings, you may be contacted for an interview." & Chr(13) & Chr(13) &_ "Thank you again for including the Woodland Park Zoological Society in your employment search! " '----------------------------------------------------------------------- ------- ' EVENT HANDLERS '----------------------------------------------------------------------- ------- ' DESCRIPTION: This event is fired when a new message is added to the folder Public Sub Folder_OnMessageCreated ' Declare variables Dim objSession ' Session Dim objFolder ' Outbox folder Dim objCurrentMsg ' Current message Dim objReplyMsg ' Reply message Dim objStatusMsg ' Status message Dim objAttachment ' Attachment Dim objFields ' Message fields Dim objField ' Message field Dim objRecipients ' Recipients collection Dim objRecipient ' Recipients object Dim strRecipients ' Recipients list Dim strMessageBody ' Message body Dim blnStatusMsg ' True if message is a status message ' Initialize variables Set objSession = Nothing Set objFolder = Nothing Set objCurrentMsg = Nothing Set objReplyMsg = Nothing Set objStatusMsg = Nothing Set objAttachment = Nothing Set objFields = Nothing Set objField = Nothing Set objRecipients = Nothing Set objRecipient = Nothing blnStatusMsg = False ' Clear error buffer Err.Clear ' Get session informationen On Error Resume Next Set objSession = EventDetails.Session ' No errors detected ? If Err.Number = 0 Then ' Write some logging Call DebugAppend(objSession.CurrentUser & " AutoReply - Proccessing startet", False) ' Get outbox folder Err.Clear On Error Resume Next Set objFolder = objSession.Outbox ' No errors detected ? If Err.Number = 0 Then ' Get current message Err.Clear On Error Resume Next Set objCurrentMsg = objSession.GetMessage(EventDetails.MessageID,Null) ' Error detected ? If Err.Number <> 0 Then ' Error reading current message Call DebugAppend("Error - Could not read message", True) Else ' Write some logging Call DebugAppend("New message with subject: <" & objCurrentMsg.Subject & "> arrived", False) ' Check if message is a non-delivery report If objCurrentMsg.Type = "REPORT.IPM.NOTE.NDR" Then blnStatusMsg = True ' Check if message is a delivery report ElseIf objCurrentMsg.Type = "REPORT.IPM.Note.DR" Then blnStatusMsg = True ' Check if message is a read notification ElseIf objCurrentMsg.Type = "REPORT.IPM.Note.IPNRN" Then blnStatusMsg = True ' Check if message is a not-read notification ElseIf objCurrentMsg.Type = "REPORT.IPM.Note.IPNNRN" Then blnStatusMsg = True ' Check if message is an out of office reply ElseIf objCurrentMsg.Type = "IPM.Note.Rules.OofTemplate.Microsoft" Then blnStatusMsg = True ' Check if message is a meeting item ElseIf Left(objCurrentMsg.Type, 12) = "IPM.Schedule" Then blnStatusMsg = True ' Check for some special cases Else ' Get fields collection of current message On Error Resume Next Set objFields = objCurrentMsg.Fields ' Check if we've got a fields collection If Not objFields Is Nothing Then ' Get auto-forwared status field On Error Resume Next Set objField = objFields.Item(CdoPR_AUTO_FORWARDED) ' Check if field found If Not objField Is Nothing Then ' Check if message is auto-forwarded If objField.Value = True Then blnStatusMsg = True End If End If ' Get sender address type field On Error Resume Next Set objField = objFields.Item(CdoPR_SENT_REPRESENTING_ADDRTYPE) ' Check if message is from an external address If objField.Value <> "EX" Then ' Get a reference to the first attachment Err.Clear On Error Resume Next Set objAttachment = objCurrentMsg.Attachments.Items(1) ' No errors detected ? If Err.Number = 0 Then ' Assign the source property of the attachment to a ' previously defined message object On Error Resume Next Set objStatusMsg = objAttachment.Source ' Check if status message found If Not objStatusMsg Is Nothing Then ' Check if message is a non-delivery report If objStatusMsg.Type = "REPORT.IPM.NOTE.NDR" Then blnStatusMsg = True ' Check if message is a delivery report ElseIf objStatusMsg.Type = "REPORT.IPM.Note.DR" Then blnStatusMsg = True ' Check if message is a read notification ElseIf objStatusMsg.Type = "REPORT.IPM.Note.IPNRN" Then blnStatusMsg = True ' Check if message is a not-read notification ElseIf objStatusMsg.Type = "REPORT.IPM.Note.IPNNRN" Then blnStatusMsg = True ' Check if message is an out of office reply ElseIf objStatusMsg.Type = "IPM.Note.Rules.OofTemplate.Microsoft" Then blnStatusMsg = True End If End If End If End If End If End If ' Check if message does not contain status information If blnStatusMsg = False Then ' No status information found, write logging Call DebugAppend("Message is not a status message, create reply", False) ' Reply message using Message.Reply() On Error Resume Next Set objReplyMsg = objCurrentMsg.Reply() ' Check if we've got a copy of the message If Not objReplyMsg Is Nothing Then ' Check if current message subject does not contain ' reply prefix If Left(UCase(objCurrentMsg.Subject), 3) <> "RE:" Then ' Set reply subject with reply prefix objReplyMsg.Subject = "RE: " & objCurrentMsg.Subject Else ' Set reply subject without reply prefix objReplyMsg.Subject = objCurrentMsg.Subject End If ' Get recipients list of current message Err.Clear On Error Resume Next Set objRecipients = objCurrentMsg.Recipients ' No errors detected ? If Err.Number = 0 Then ' Loop through recipients collection and add recipient names For Each objRecipient In objRecipients If strRecipients <> "" Then strRecipients = strRecipients & "; " & objRecipient.Name Else strRecipients = objRecipient.Name End If Next Else ' Set current user as only recipient strRecipients = objSession.CurrentUser End If ' Constuct message body strMessageBody = Chr(13) & Chr(13) & Chr(13) & "-----Original Message-----" & Chr(13) _ & "From: " & objCurrentMsg.Sender & Chr(13) & "Sent: " & objCurrentMsg.TimeReceived & Chr(13) _ & "To: " & strRecipients & Chr(13) & "Subject: " & objCurrentMsg.Subject & Chr(13) & Chr(13) ' Set message body objReplyMsg.Text = g_Const_ReplyText & strMessageBody & objCurrentMsg.Text ' Update and send message Err.Clear On Error Resume Next objReplyMsg.Update objReplyMsg.Send ' Errors detected ? If Err.Number <> 0 then ' Could not sent reply message, write logging Call DebugAppend("Error - Could not send reply message", True) Else ' Reply message successfully sent Call DebugAppend("Success - Reply message send successfully", False) ' Get fields collection of current message On Error Resume Next Set objFields = objCurrentMsg.Fields ' Check if we've got a fields collection If Not objFields Is Nothing Then ' Set the reply flags of the current message On Error Resume Next objFields.Add CdoPR_ACTION_DATE, Now On Error Resume Next objFields.Add CdoPR_ACTION, ACTION_REPLY On Error Resume Next objFields.Add CdoPR_ACTION_FLAG, ACTION_REPLY_SENDER ' Update current message On Error Resume Next objCurrentMsg.Update True, True ' Mark current message as read objCurrentMsg.Unread = False End If End If End If Else ' Status information found, write logging Call DebugAppend("Message is a status message, no reply sent", False) End If End If Else ' Write some logging Call DebugAppend("Error - Could not get outbox folder", True) End If Else ' Write some logging Call DebugAppend("Undefinied Error detected", True) End If ' Write some logging Call DebugAppend("AutoReply - Processing finished", False) ' Clear objects Set objSession = Nothing Set objFolder = Nothing Set objCurrentMsg = Nothing Set objReplyMsg = Nothing Set objStatusMsg = Nothing Set objAttachment = Nothing Set objFields = Nothing Set objField = Nothing Set objRecipients = Nothing Set objRecipient = Nothing ' Write results to the Scripting Agent log Script.Response = g_bstrDebug End Sub ' DESCRIPTION: This event is fired when the timer on the folder expires Public Sub Folder_OnTimer 'Not used 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 '-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- +-+-+-+ ' 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> _________________________________________________________________ List posting FAQ: http://www.swinc.com/resource/exch_faq.htm Archives: http://www.swynk.com/sitesearch/search.asp To unsubscribe: mailto:[EMAIL PROTECTED] Exchange List admin: [EMAIL PROTECTED] _________________________________________________________________ List posting FAQ: http://www.swinc.com/resource/exch_faq.htm Archives: http://www.swynk.com/sitesearch/search.asp To unsubscribe: mailto:[EMAIL PROTECTED] Exchange List admin: [EMAIL PROTECTED]
