Option Public
Option Declare

Sub Initialize
	' agent runs on schedule, looks for anything in a forwarding folder and forwards it
	' it is assumed this agent is added to mail template and set to run on schedule

	Dim s As New NotesSession
	Dim db As NotesDatabase								' current mail file
	Dim lupV As NotesView								' docs in forwarding folder
	Dim lupECol As NotesViewEntryCollection						' all docs in folder, to be forwarded, each is removed after send
	Dim lupE As NotesViewEntry							' current entry being forwarded in lupECol
	Dim lupENext As NotesViewEntry							' entry in lupECol after lupE
	Dim lupDoc As NotesDocument							' current lupE doc being forwarded
	Dim viewnm As String								' view/folder to forward
	Dim emailfld As String								' name of field that contains the sendto replacement
	Dim emaildomain As String							' domain suffix for email sendto replacement
	Dim emaillimit As Long								' limit of number to process during this run
	Dim pDoc As NotesDocument							' preferences doc in mail file (needed to get mailfile owner)
	Dim ownernm As String								' owner in pDoc
	Dim newSendTo As String								' new SendTo value using emailfld in person doc
	Dim counter As Long								' counter, use for limit
	
	On Error Goto ErrorHandler
	
	' setup
	viewnm = "ForwardFolderName"
	emailfld = "Owner"
	emaildomain = "@MWClient"				' new domain to forward
	emaillimit = 1000
	Set db = s.CurrentDatabase
	If Not (db.TemplateName = "") Then
		' quit db is template
		Exit Sub
	End If
	Set lupV = db.GetView(viewnm)
	If (lupV Is Nothing) Then
		Print "Error: Missing view: " & viewnm & ". Aborted Forward to Domain agent."
		Exit Sub
	End If
	Set lupECol = lupV.AllEntries
	If (lupECol Is Nothing) Then
		Print "Error: Unable to get all entries collection for view: " & viewnm & ". Aborted Forward to Domain agent."
		Exit Sub
	End If
	If (lupECol.Count = 0) Then
		' not an issue, just nothing to do, quit
		Exit Sub
	End If
	
	' have something to process...
	' get owner of this mail file (old receipient) - cannot use original sendto, recipient can be any value
	Set pDoc = db.GetProfileDocument("CalendarProfile")
	If Not (pDoc Is Nothing) Then
		ownernm = pDoc.Owner(0)
		If (ownernm = "") Then
			Print "Error: Owner for this mail file is not set (populated in profile/preferences). Cannot forward messages from " & viewnm & ". Aborted Forward to Domain agent."
			Exit Sub
		End If
	Else
		' no preference file???
		Print "Error: Unable to get owner for this mail file. Cannot forward messages from " & viewnm & ". Aborted Forward to Domain agent."
		Exit Sub		
	End If
	
	' have owner, get person doc so we can get shortname
	newSendTo = GetPersonFldVal(s, db, ownernm, emailfld)
	
	' test that we have a value
	If (newSendTo = "") Then
		' give up
		Print "Error: Unable to get field, " & emailfld & ", for owner, " & ownernm & ",  for this mail file. Cannot build new SendTo value to forward messages from " & viewnm & ". Aborted Forward to Domain agent."
		Exit Sub
	Else
		' build new e-mail address format
		newSendTo = newSendto & emaildomain
	End If
	
	' loop and process entries in folder
	Set lupE = lupECol.GetFirstEntry()
	counter = 0
	While Not (lupE Is Nothing)
		Set lupENext = lupECol.GetNextEntry(lupE)
		' get doc
		Set lupDoc = lupE.Document
		If Not (lupDoc Is Nothing) Then
			' process doc
			If (ProcessEmail(s, db, lupDoc, newSendTo)=1) Then
				' success, remove from folder
				Call lupDoc.RemoveFromFolder(viewnm)
				counter = counter + 1
				Print "Successfully processed e-mail: " & Cstr(counter) &"."
			End If
			
		End If
		' test for  limit
		If (counter > emaillimit) Then
			Print "Forward limit hit. Done."
			' skip
			Goto SkipDone
		End If
		' loop
		Set lupE =  lupENext
	Wend
SkipDone:
	' done
	Print "Ran agent on " & Cstr(lupECol.Count) & " documents."
	Exit Sub
	
ErrorHandler:
	Print "Unexpected Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl)
End Sub


Function ProcessEmail(s As NotesSession, db As NotesDatabase, lupDoc As NotesDocument, newSendTo) As Integer
	' forwards current entry/doc, and returns 1 if successful
	' newSendTo should be internet address or Canonical Notes name
	Dim mDoc As NotesDocument	' new memo doc created from original doc
	
	On Error Goto FErrorHandler
	
	' create new doc from current document
	Set mDoc = db.CreateDocument()
	Call lupDoc.CopyAllItems(mDoc, True)
	mDoc.SaveMessageOnSend = False
	
	' remap from/sendto/replyto so when forwarded still be from original person
	Call mDoc.ReplaceItemValue("SendTo", newSendTo)
	Call mDoc.ReplaceItemValue("CopyTo", "")				' otherwise another copy will be sent
	Call mDoc.ReplaceItemValue("BlindCopyTo", "")		' otherwise another copy will be sent
	
	' send new doc
	Call mDoc.Send(False, newSendTo)
	' reset to nothing
	Set mDoc = Nothing
	
	' return success (if got here it was sent okay)
	ProcessEmail = 1
FExit:
	Exit Function
	
FErrorHandler:
	Print "(ProcessEmail) Unexpected Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl)
	ProcessEmail = 0
	Exit Function
End Function