vijayasree: 2013

Monday, February 4, 2013

Lotus Script for Extract the Mails from Mail DB (i.e sending and receiving to ther domains)

Sub Initialize
Dim session As New NotesSession
Dim curdb As NotesDatabase
Dim prfview As NotesView
Dim prfdoc As NotesDocument
Dim maildb As NotesDatabase
Dim maildbvw As NotesView
Dim maildbdoc As NotesDocument
Dim domvw As NotesView
Dim domdoc As NotesDocument
Dim fromitem As NotesItem
Dim fromval As String
Dim toval As String
Dim infodoc As NotesDocument
Dim polarisdomain As Boolean
Dim otherdomainto As Boolean
Dim otherdomaincc As Boolean
Dim torole As String
Dim copyval As String
Dim copyrole As String
Dim n As Integer
Dim m As Integer
Dim a As Integer
Dim b As Integer
Dim temptorole As Boolean
Dim tempcopyrole As Boolean
Dim temptorole_rec As Boolean
Dim tempcopyrole_rec As Boolean
Dim Recipientsrole As String
Dim temp As String

Dim FromValSender As String

temptorole=False
tempcopyrole=False
temptorole_rec=False
tempcopyrole_rec=False

Set curdb=session.Currentdatabase

Set domvw=curdb.Getview("DomainNamsVw")
Set domdoc=domvw.Getfirstdocument()

Set prfview=curdb.Getview("Profile")
Set prfdoc=prfview.Getfirstdocument()

If prfdoc Is Nothing Then
  Exit Sub
End If
While Not prfdoc Is Nothing
  Set maildb=session.Getdatabase(prfdoc.sername(0),prfdoc.filename(0))
  Set maildbvw=maildb.Getview("($All)")
  Set maildbdoc=maildbvw.Getfirstdocument()
  If maildbdoc Is Nothing Then
   Exit Sub
  End If
  a=0
  b=0
  While Not maildbdoc Is Nothing
   FromValSender = False
   polarisdomain = False
   otherdomainto= False
   otherdomaincc= False
   temptorole=False
   tempcopyrole=False
   temptorole_rec=False
   tempcopyrole_rec=False

   copyrole=""
   torole=""
   temp=""
   'Forall obj In domdoc.domains    '//Mail from other domain ex: gmail to polarisFt
    fromval = CStr(maildbdoc.from(0))             '// only From is validated for Gmail
    toval=maildbdoc.SendTo(0)
    copyval=maildbdoc.CopyTo(0)
   ForAll obj In domdoc.domains
     If InStr(Trim(UCase(CStr(fromval))),Trim(UCase(CStr(obj)))) > 0 Then 'Condition for Mail from other Domain to polaris domain receiver
       polarisdomain = True
     End If
   End ForAll
   ForAll obj In domdoc.domains             '//Mail from polaris domain to others ex; PolarisFt to Gmail
     If InStr(Trim(UCase(CStr(fromval))),Trim(UCase(CStr(obj)))) > 0 Then
      FromValSender = true
      'To Condition
      If UBound(maildbdoc.SendTo) > 0 Then
        ForAll z In maildbdoc.SendTo
       ForAll k In domdoc.domains
        If (Trim(z) = "") Then
         Exit forall
        End If
        If (InStr(z,"@") = 0 Or (InStr(Trim(UCase(z)),Trim(UCase(k))) > 0)) Then '// for group name and valid polaris domain name checking
          otherdomainto = True
          Exit ForAll
         End If
       End ForAll
       If otherdomainto = False Then
        Exit forall
       End If
        End ForAll
         Else
       otherdomainto = true
         End If

      'CC Condition
      If UBound(maildbdoc.CopyTo) > 0 Then
        ForAll j In maildbdoc.CopyTo
       ForAll g In domdoc.domains
        If (Trim(j)= "") Then
         Exit forall
        End If
        If (InStr(j,"@") = 0 Or (InStr(Trim(UCase(j)),Trim(UCase(g))) > 0)) Then
         otherdomaincc = True
            Exit ForAll
        End If
       End ForAll

       If otherdomaincc = False Then    '// for group name checking
        Exit ForAll
       End If

      End ForAll
       Else
      otherdomaincc = true
       End If
    Exit forall
   End If
   End ForAll

   'Mail from other Domain to polaris domain
  If (polarisdomain = False) Then             '//create receiver doc
    n=1
    ForAll x In maildbdoc.SendTo
     If Trim(x)="" Then
      Exit ForAll
     End If

     ForAll p In domdoc.domains
      If (InStr(Trim(UCase(x)),Trim(UCase(p))) > 0) Then
       temptorole_rec = True
       Exit ForAll
      End If
     End ForAll
     If (temptorole_rec = True) Then

      Set infodoc = curdb.CreateDocument
      infodoc.form="Information_Receiver"
      infodoc.txt_sender = maildbdoc.from(0)
      infodoc.txt_date = maildbdoc.PostedDate(0)
      infodoc.mid_receiver=maildbdoc.Universalid
      'infodoc.txt_to = x
      infodoc.receivernam="Receiver"
      infodoc.txt_receiver = x
      infodoc.txt_dbname=maildb.Filename
      infodoc.count_receiver="1"
      Call infodoc.Save( True, True )

     End If
     n=0
     temptorole_rec=False
     tempcopyrole_rec=False
    End ForAll
    m=1
    ForAll y In maildbdoc.CopyTo
     If Trim(y)="" Then
      Exit ForAll
     End If
     ForAll q In domdoc.domains
      If (InStr(Trim(UCase(y)),Trim(UCase(q))) > 0) Then
       tempcopyrole_rec = True
       Exit ForAll
      End If
     End ForAll
     If (tempcopyrole_rec = True) Then
      Set infodoc = curdb.CreateDocument
      infodoc.form="Information_Receiver"
      infodoc.txt_sender = maildbdoc.from(0)
      infodoc.txt_date = maildbdoc.PostedDate(0)
      infodoc.mid_receiver=maildbdoc.Universalid
      'infodoc.txt_cc = y
      infodoc.txt_receiver = y
      infodoc.receivernam="Receiver"
      infodoc.txt_dbname=maildb.Filename
      infodoc.count_receiver="1"
      Call infodoc.Save( True, True )
     End If
     m=0
     temptorole_rec=False
     tempcopyrole_rec=False
    End ForAll
  End If

   'If the polaris domain to otherdomain
   If FromValSender = True And (otherdomainto = False Or otherdomaincc = False) Then   '//create sender doc
     ForAll s In maildbdoc.SendTo
      ForAll d In domdoc.domains
       If (InStr(Trim(UCase(s)),Trim(UCase(d))) > 0) Then
        temptorole = True
        Exit ForAll
       End If
      End ForAll
      If (Trim(s)="") Then
       Exit ForAll
      End If
      a=1
      If (temptorole = False) Then
       Set infodoc = curdb.CreateDocument
       infodoc.form="Information_Sender"
       infodoc.txt_sender = maildbdoc.from(0)
       infodoc.txt_date = maildbdoc.PostedDate(0)
       infodoc.mid_sender=maildbdoc.Universalid
       'torole=torole+s+","
       infodoc.txt_receiver = s
       infodoc.sendernam = "Sender"
       infodoc.txt_dbname=maildb.Filename
       infodoc.count_sender="1"
       Call infodoc.Save( True, True )
      End If
      a=0

     End ForAll

    b=1
    copyrole=""
     ForAll h In maildbdoc.CopyTo

      ForAll e In domdoc.domains
       If (InStr(Trim(UCase(h)),Trim(UCase(e))) > 0) Then
        tempcopyrole = True
        Exit ForAll
       End If
      End ForAll

      If (Trim(h) = "") Then
       Exit ForAll
      End If
      b=1
      If (tempcopyrole = False) Then
       Set infodoc = curdb.CreateDocument
       infodoc.form="Information_Sender"
       infodoc.txt_sender = maildbdoc.from(0)
       infodoc.txt_date = maildbdoc.PostedDate(0)
       infodoc.sendernam = "Sender"
       infodoc.mid_sender=maildbdoc.Universalid
       'copyrole=copyrole+h+","
       infodoc.txt_receiver = h
       infodoc.count_sender="1"
       infodoc.txt_dbname=maildb.Filename
       Call infodoc.Save( True, True )
      End If

      %REM

      If (Trim(h)="") Then
       Exit ForAll
      End If
      %END REM
      b=0
       End ForAll
   End If
   polarisdomain = False
   otherdomainto=False
   otherdomaincc=False
   temptorole=False
   tempcopyrole=False
   temptorole_rec=False
   tempcopyrole_rec=False
   Set maildbdoc=maildbvw.Getnextdocument(maildbdoc)
  Wend
  Set prfdoc=prfview.Getnextdocument(prfdoc)
Wend
MsgBox "Done"
End Sub

vijayasree

Monday, February 4, 2013

Lotus Script for Extract the Mails from Mail DB (i.e sending and receiving to ther domains)

Extract the Mails from Mail DB (i.e who are sending to ther domains

Extract the Mails from Mail DB who are sending to ther domains

Extract the Mails who are sending to ther domains

About Me

Blog Archive