Thanks for replying Leslie. An explanation is in order. We have an External AntiSpam system setup which passes any mails that it thinks are spam to a notes mailbox. I regularly go through this mailbox and if I find mails that are legitimate, I want to be able to pass them on to the original intended recipient, without losing their ability to reply to sender. The agent below runs from the actions menu on a selected mail document and keeps the from field as it should have been. The script works fine, except that I want to mark the ones that I have forwarded as deleted, but I dont want to actually delete them until I am happy that they have been received ok (maybe after a day or week). The last two lines commented out didn't work (error popup= Object variable not set).
If you can give some assistance, it would be great.
{Declarations section}
Dim maildb As NotesDatabase
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim newdoc As NotesDocument
Dim dc As notesdocumentcollection
{Initialize section}
Sub Initialize
Dim session As New NotesSession
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set db = session.CurrentDatabase
Set dc = db.unprocesseddocuments
servername=Evaluate("@subset(@maildbname;1)"
Set maildb=session.getdatabase(servername(0),"Mail1.box"

If Not maildb.isopen Then
Set maildb=session.getdatabase(servername(0), "Mail2.box"

End If
If Not maildb.isopen Then
Set maildb=session.getdatabase(servername(0), "Mail.Box"

End If
If Not maildb.isopen Then
Set maildb=session.getdatabase(servername(0), "Mail3.Box"

End If
If Not maildb.isopen Then
Set maildb=session.getdatabase(servername(0), "Mail4.Box"

End If
If Not maildb.isopen Then
Set maildb=session.getdatabase(servername(0), "Mail5.Box"

End If
If Not Maildb.isopen Then
Messagebox "Unable to locate Mail Router, Please try again Later", 0+64, "Error !"
Exit Sub
End If
Set newdoc = New Notesdocument(maildb)
Set doc = dc.getnthdocument(1)
Call doc.CopyAllItems(newdoc, True)
newdoc.recipients = doc.X_SpamOriginallyTo
Call newdoc.Save(True, True)
' Set uidoc = workspace.CurrentDocument
' Call uidoc.DeleteDocument
End Sub