Calendar Entry Migration From One mail box to another by lotus script

%REM
    Agent Moving Documents
    Created Jul 12, 2011 by versa14.it/Polaris
    Description: Comments for Agent
%END REM
Option Public



   
    'Declaration part
    Dim session As NotesSession
   
    Dim curdb As NotesDatabase
    Dim dbSource As NotesDatabase, dbDest As NotesDatabase
    Dim UMTdb As NotesDatabase
    Dim PABdb As NotesDatabase
   
   
    Dim view As NotesView
    Dim Profileview As NotesView
    Dim sourc As NotesView, dest As NotesView
    Dim vc As NotesViewEntryCollection
    Dim ve As NotesViewEntry
    Dim Nview As NotesView
   
    Dim doc As NotesDocument
    Dim UMTdoc As NotesDocument
    Dim docDest As NotesDocument
    Dim Logform As NotesDocument
   
    Dim collect As NotesDocumentCollection
    Dim item As NotesItem
    Dim col As NotesViewEntryCollection
    Dim doccoll As NotesDocumentCollection
    Dim ActivityLogRTItem As NotesRichTextItem
   
    Dim dname As String
    Dim sname  As String
    Dim folders() As String
    Dim nam As NotesName
    Dim tempnam As String
    Dim i As Integer
    Dim ret
    Dim sername,mailfile As Variant
    Dim s_servername As String
    Dim s_databasename As String
    Dim d_saervername As String
    Dim d_databasename As String
    Dim mcount As Integer
    Dim MIGR_STATUS As Variant
    Dim startdate As Variant
    Dim temp As Variant
    Dim DueDate As Variant
    Dim foldername As String
   
   
Sub Initialize
    On Error GoTo ErrHandler
    Set session= New NotesSession
    Set curdb=session.CurrentDatabase
    Set Logform=curdb.CreateDocument
    Logform.Form="Log Form"   
    Logform.Server=curdb.Server
    Logform.StartTime=Now
    Set ActivityLogRTItem = New NotesRichTextItem( Logform, "Rtxtlogactivity" )
    Call ActivityLogRTItem.AppendText( Now+ ": "&"Migrate calendar entries Agent Started")
    Call ActivityLogRTItem.AddNewLine( 1)
    Set Profileview=curdb.GetView("ProfileView")
    Set doc=Profileview.GetFirstDocument()
    If Not doc Is Nothing Then
    If IsEmpty( doc.servername_s(0) ) Then
        MsgBox "Source server name is not mentioned in the Profile document"
        Exit Sub
    End If
        Call Mail_box(doc)
    End If
   
    Logform.FinishTime=Now
    Call ActivityLogRTItem.AppendText( Now+ ": "&"End of Scan")
    Call ActivityLogRTItem.AddNewLine( 1)   
    Call ActivityLogRTItem.AppendText( Now+ ": "&"Migrate calendar entries Agent Ended")
    Call ActivityLogRTItem.AddNewLine( 1)
    Call Logform.Save(True,False)
    Exit Sub
ErrHandler:
    Logform.FinishTime=Now
    Call ActivityLogRTItem.AppendText( Now+ ": "&"Scan Skipped")
    Call ActivityLogRTItem.AddNewLine( 1)               
    Call Logform.Save(True,False)           

End Sub
Sub Mail_Box(doc As NotesDocument)
        'On Error GoTo ErrHandler
        Dim dt As New NotesDateTime(CStr(Now()))
        s_servername=doc.servername_s(0)
        s_databasename=doc.databasename_s(0)
        tempnam=session.Username
        Set nam=session.Createname(tempnam)
        Set UMTdb = session.Getdatabase(s_servername,s_databasename)
        Set view=UMTdb.GetView("($VIMPeople)")
        Set UMTdoc=view.GetDocumentByKey(nam.Abbreviated)
        If Not UMTdoc Is Nothing Then
            sname=UMTdoc.MailServerX(0)
            dname=UMTdoc.MailFileX(0)
        End If
        Set dbSource = session.GetDatabase(sname,dname, False )               
        Set sourc = dbSource.GetView("($EntriesOnMyCalendarByCategory)")
        Call sourc.Refresh()   
        Set dbDest = session.GetDatabase( UMTdoc.MailServer(0),UMTdoc.MailFile(0), False )
        Call ActivityLogRTItem.AppendText(Now + ": "+ "Scanning Mail File  " +mailfile)
        Call ActivityLogRTItem.AddNewLine( 1)
        Set vc=sourc.AllEntries
        Set ve = vc.GetFirstEntry   
        mcount=0
        temp=Today
       
        'Calendar           
        Do Until ve Is Nothing
            MIGR_STATUS=ve.Document.Getitemvalue("MIGR_STATUS")
            startdate=ve.Document.Getitemvalue("StartDate")
            DueDate=ve.Document.Getitemvalue("DueDate")
            If CStr(MIGR_STATUS(0))="Yes" Then   
            Else   
                If CDat(startdate(0))>= CDat(temp) Then               
                Set docDest = ve.Document.CopyToDatabase(dbDest )
                    mcount=mcount+1
                End If   
            End If
            Set ve = vc.GetNextEntry( ve )
        Loop   
        Call vc.StampAll("MIGR_STATUS","Yes")
        'End Cal
       
        '%TO Do
            Set sourc = dbSource.GetView("($ToDo)")
        Call sourc.Refresh()   
        Call ActivityLogRTItem.AppendText(Now + ": "+ "Scanning Mail File  " +mailfile)
        Call ActivityLogRTItem.AddNewLine( 1)
        Set vc=sourc.AllEntries
        Set ve = vc.GetFirstEntry   
        temp=Today
        Do Until ve Is Nothing
            MIGR_STATUS=ve.Document.Getitemvalue("MIGR_STATUS")
            startdate=ve.Document.Getitemvalue("StartDate")
            DueDate=ve.Document.Getitemvalue("DueDate")
            If CStr(MIGR_STATUS(0))="Yes" Then   
            Else   
                If  CDat(startdate(0))>= CDat(temp) Then               
                Set docDest = ve.Document.CopyToDatabase(dbDest )
                mcount=mcount+1
                else
                    If  cdat(DueDate(0))>= cdat(temp)  Then               
                    Set docDest = ve.Document.CopyToDatabase(dbDest )
                    mcount=mcount+1
                End If
                End If
        End If
            Set ve = vc.GetNextEntry( ve )
        Loop   
        Call vc.StampAll("MIGR_STATUS","Yes")
        'END TO Do
    Print "Calendar Entries are Migrated no:"& mcount   
    Call ActivityLogRTItem.AppendText( Now+ ": "&"Number Migrated Calendar Entries: "& mcount)
    Call ActivityLogRTItem.AddNewLine( 1)
    Exit Sub
ErrHandler:
    Logform.FinishTime=Now
    Call ActivityLogRTItem.AppendText( Now+ ": "&"Scan Skipped")
    Call ActivityLogRTItem.AddNewLine( 1)               
    Call Logform.Save(True,False)   
End Sub