Extract the Mails from Mail DB (i.e who are sending 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