Automatisches Bearbeiten und Weiterleiten in Outlook

Public Sub MessageScript(oMail As Outlook.mailItem)
    Dim msgBody
    Dim newSMSMail As Outlook.mailItem
    Set newSMSMail = Application.CreateItem(olMailItem)
    msgBody = oMail.Body
    Dim strDescription, strCustomer, strPrio, posDescription, posCustomer, posPrio
    posDescription = InStr(1, msgBody, "Description") + 11  
    posCustomer = InStr(1, msgBody, "Customer") + 8  
    posPrio = InStr(1, msgBody, "Priority") + 8  
    strDescription = Mid(msgBody, posDescription, InStr(posDescription, msgBody, "Customer") - posDescription)  
    strCustomer = Mid(msgBody, posCustomer, InStr(posCustomer, msgBody, "Department") - posCustomer)  
    strPrio = Mid(msgBody, posPrio, InStr(posPrio, msgBody, "Affected Users") - posPrio)  
    strDescription = Trim(Replace(strDescription, vbCrLf, ""))  
    strCustomer = Trim(Replace(strCustomer, vbCrLf, ""))  
    strPrio = Trim(Replace(strPrio, vbCrLf, ""))  
    With newSMSMail
        .To = "hier@empfänger.de"  
        .Subject = "+49xxxxxxxx"  
        .Body = "Description: " & vbCrLf & strDescription & vbCrLf & _  
                "Customer: " & vbCrLf & strCustomer & vbCrLf & _  
                "Priority: " & vbCrLf & strPrio  
        .Display
    End With

End Sub

Public Sub MessageScript(oMail as Outlook.mailitem)
    Dim msgBody
    Dim newSMSMail As Outlook.mailItem
    Set newSMSMail = Application.CreateItem(olMailItem)
    msgBody = oMail.Body
    Dim strDescription, strCustomer, strPrio, posDescription, posCustomer, posPrio
    posDescription = InStr(1, msgBody, "Description") + 11  
    posCustomer = InStr(1, msgBody, "Customer") + 8  
    posPrio = InStr(1, msgBody, "Priority") + 8  
    strDescription = Mid(msgBody, (InStr(posDescription, msgBody, ":") + 1), InStr(posDescription, msgBody, "Customer") - (InStr(posDescription, msgBody, ":") + 1))  
    strCustomer = Mid(msgBody, (InStr(posCustomer, msgBody, ":") + 1), InStr(posCustomer, msgBody, "Department") - (InStr(posCustomer, msgBody, ":") + 1))  
    strPrio = Mid(msgBody, (InStr(posPrio, msgBody, ":") + 1), InStr(posPrio, msgBody, "Affected Users") - (InStr(posPrio, msgBody, ":") + 1))  
    strDescription = Trim(Replace(strDescription, vbCrLf, ""))  
    strCustomer = Trim(Replace(strCustomer, vbCrLf, ""))  
    strPrio = Trim(Replace(strPrio, vbCrLf, ""))  
    With newSMSMail
        .To = "hier@empfänger.de"  
        .Subject = "+49xxxxxxxx"  
        .Body = "Description: " & vbCrLf & strDescription & vbCrLf & _  
                "Customer: " & vbCrLf & strCustomer & vbCrLf & _  
                "Priority: " & vbCrLf & strPrio  
        .Display
    End With

End Sub

Public Sub MessageScript(oMail as Outlook.mailitem)
    Dim msgBody
    Dim newSMSMail As Outlook.mailItem
    Set newSMSMail = Application.CreateItem(olMailItem)
    msgBody = oMail.Body
    Dim strDescription, strCustomer, strPrio, strTel, posDescription, posCustomer, posPrio, posTel
    posDescription = InStr(1, msgBody, "Description") + 11  
    posCustomer = InStr(1, msgBody, "Customer") + 8  
    posPrio = InStr(1, msgBody, "Priority") + 8  
    posTel = InStr(1,msgBody,"Telephone")+ 13  
    strDescription = Mid(msgBody, (InStr(posDescription, msgBody, ":") + 1), InStr(posDescription, msgBody, "Customer") - (InStr(posDescription, msgBody, ":") + 1))  
    strCustomer = Mid(msgBody, (InStr(posCustomer, msgBody, ":") + 1), InStr(posCustomer, msgBody, "Department") - (InStr(posCustomer, msgBody, ":") + 1))  
    strPrio = Mid(msgBody, (InStr(posPrio, msgBody, ":") + 1), InStr(posPrio, msgBody, "Affected Users") - (InStr(posPrio, msgBody, ":") + 1))  
   strTel = Mid(msgBody, (InStr(posTel, msgBody, ":") + 1), InStr(posTel, msgBody, "Room") - (InStr(posTel, msgBody, ":") + 1))  
  
   strDescription = Trim(Replace(strDescription, vbCrLf, ""))  
    strCustomer = Trim(Replace(strCustomer, vbCrLf, ""))  
    strPrio = Trim(Replace(strPrio, vbCrLf, ""))  
    strTel = Trim(Replace(strTel, vbCrlLf,""))  
    With newSMSMail
        .To = "hier@empfänger.de"  
        .Subject = "+49xxxxxxxx"  
        .Body = "Description: " & vbCrLf & strDescription & vbCrLf & _  
                "Customer: " & vbCrLf & strCustomer & vbCrLf & _  
                "Priority: " & vbCrLf & strPrio & vbCrLf & _  
                "Tel.: " & strTel  
        .Display
    End With

End Sub

<SCRIPT RunAt=Server Language=VBScript>

'------------------------------------------------------------------------------  
'  
' NAME: Forward  
'  
' FILE DESCRIPTION: Automatically forwards all incomming messages to SMS Server  
'  
'  
'------------------------------------------------------------------------------  

'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 CdoPR_TRANSPORT_MESSAGE_HEADERS = &H007D001E
Const CdoPR_RTF_COMPRESSED = &H10090102

Const ACTION_REPLY = 261
Const ACTION_FORWARD = 262
Const ACTION_REPLY_SENDER = 102
Const ACTION_REPLY_ALL = 103
Const ACTION_FORWARD_FORWARD = 104

' Forward address type and e-mail address  
Const g_Const_ForwardAddress_Type = "SMTP"  

'hier musst du die empfänger-email eintragen  
Const g_Const_ForwardAddress = "Administrator@sbs2003.local"  

'------------------------------------------------------------------------------  
'	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 objForwardMsg					' Current message  
	Dim objFields						' Message fields  
	Dim objField						' Message field  
	Dim objRecipient					' Recipient  

	' Initialize variables  
	Set objSession = Nothing
	Set objFolder = Nothing
	Set objCurrentMsg = Nothing
	Set objForwardMsg = Nothing
	Set objFields = Nothing
	Set objField = Nothing
	Set objRecipient = Nothing

	' 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 & " AutoForward - 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 current message", True)  
			Else

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

				 'Create forward message, write logging  
				Call DebugAppend("Create forward message", False)  

				' Forward message using Message.Forward()  
				On Error Resume Next
				Set objForwardMsg = objCurrentMsg.Forward()

				' Check if we've got a copy of the message  
				If Not objForwardMsg Is Nothing Then
					
					' Check if current message subject does not contain  
					' forward prefix  
					If Left(UCase(objCurrentMsg.Subject), 3) <> "FW:" Then  

						' Set forward subject with forward prefix  
						objForwardMsg.Subject = "FW: " & objCurrentMsg.Subject  
					Else

						' Set forward subject without forward prefix  
						objForwardMsg.Subject = objCurrentMsg.Subject
					End If

					Dim msgBody, strDescription, strCustomer, strPrio, strTel, posDescription, posCustomer, posPrio, posTel
					On Error Resume Next
					msgBody = objCurrentMsg.Text
   					posDescription = InStr(1, msgBody, "Description") + 11  
    					posCustomer = InStr(1, msgBody, "Customer") + 8  
    					posPrio = InStr(1, msgBody, "Priority") + 8  
					posTel = InStr(1,msgBody,"Telephone")+ 13  
					strDescription = Mid(msgBody, (InStr(posDescription, msgBody, ":") + 1), InStr(posDescription, msgBody, "Customer") - (InStr(posDescription, msgBody, ":") + 1))  
    					strCustomer = Mid(msgBody, (InStr(posCustomer, msgBody, ":") + 1), InStr(posCustomer, msgBody, "Department") - (InStr(posCustomer, msgBody, ":") + 1))  
    					strPrio = Mid(msgBody, (InStr(posPrio, msgBody, ":") + 1), InStr(posPrio, msgBody, "Affected Users") - (InStr(posPrio, msgBody, ":") + 1))  
   					strTel = Mid(msgBody, (InStr(posTel, msgBody, ":") + 1), InStr(posTel, msgBody, "Room") - (InStr(posTel, msgBody, ":") + 1))  
  
   					strDescription = Trim(Replace(strDescription, vbCrLf, ""))  
    					strCustomer = Trim(Replace(strCustomer, vbCrLf, ""))  
    					strPrio = Trim(Replace(strPrio, vbCrLf, ""))  
    					strTel = Trim(Replace(strTel, vbCrlLf,""))  
					If err.Number <> 0 then
						Call DebugAppend("Error - Could not format strings for body" , True)  
					End if
					strNewBody = "Description: " & vbCrLf & strDescription & vbCrLf & "Customer: " & vbCrLf & strCustomer & vbCrLf & "Priority: " & vbCrLf & strPrio & vbCrLf & "Tel.: " & strTel  

					' Set plain text message body  
					objForwardMsg.Text = strNewBody



					' Set recipient to forward message  
					On Error Resume Next
					Set objRecipient = objForwardMsg.Recipients.Add

					' Check if recipient added successful  
					If Not objRecipient Is Nothing Then
						objRecipient.Name = g_Const_ForwardAddress
						objRecipient.Address = g_Const_ForwardAddress
					End If

						' Resolve recipient  
						On Error Resume Next
						objRecipient.Resolve


						' Update and send message  
						Err.Clear
						On Error Resume Next
						objForwardMsg.Update
						objForwardMsg.Send

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

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

							' Forward message successfully sent  
							Call DebugAppend("Success - Forward message send successfully", False)  

							

							' Mark current message as read  
							objCurrentMsg.Unread = False
						
						End If
					
				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, without the folder name  
	Call DebugAppend("AutoForward - Processing finished", False)  

	' Clear objects  
	Set objSession = Nothing
	Set objFolder = Nothing
	Set objCurrentMsg = Nothing
	Set objForwardMsg = Nothing
	Set objFields = Nothing
	Set objField = 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>