Solved

An agent that detachs the attachements ..

Posted on 2003-11-22
15
764 Views
Last Modified: 2013-12-18
Guys,

I need an agent which detachs all the attachments of the mail that comes from abc@abc.com email id. The attachments should be kept in a folder e.g. C:\ABC_Attachments\

Regards
0
Comment
Question by:ninteen83
  • 10
  • 2
  • 2
  • +1
15 Comments
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9805411
Create an agent that runs on new incoming mails.

1. Extract the source domain from the From field
2. Build the Target path
3. Use @FileSaveAttchments formula to save the attachments to the destination path

Do you want help with the code?
0
 

Author Comment

by:ninteen83
ID: 9805415
Yeah Ranjeet ! please send me the code.
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9805530
Try this:


Sub Initialize
      Dim sn As New NotesSession
      Dim doc As NotesDocument
      Dim rtitem As Variant
      Dim fileCount As Integer
      Dim fileName As String
      Dim fromName As NotesName
      Dim Path As String
      Const MAX = 100000
      
      fileCount = 0    
      Set doc = sn.DocumentContext
      Set fromName = New NotesName(doc.GetFirstItem("From").Text)
      Path = "C:\" + fromName.Addr821
      Set rtitem = doc.GetFirstItem( "Body" )
      If ( rtitem.Type = RICHTEXT ) Then
            Forall o In rtitem.EmbeddedObjects
                  If ( o.Type = EMBED_ATTACHMENT ) _
                  And ( o.FileSize > MAX ) Then
                        fileCount = fileCount + 1
                        Call o.ExtractFile _
                        ( "c:\reports\newfile" & Cstr(fileCount) )
                        Call o.Remove
                        Call doc.Save( True, True )
                  End If
            End Forall
      End If
End Sub
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9805531
Try this:


Sub Initialize
      Dim sn As New NotesSession
      Dim doc As NotesDocument
      Dim rtitem As Variant
      Dim fileCount As Integer
      Dim fileName As String
      Dim fromName As NotesName
      Dim Path As String
      Const MAX = 100000
      
      fileCount = 0    
      Set doc = sn.DocumentContext
      Set fromName = New NotesName(doc.GetFirstItem("From").Text)
      Path = "C:\" + fromName.Addr821 + "\"
      Set rtitem = doc.GetFirstItem( "Body" )
      If ( rtitem.Type = RICHTEXT ) Then
            Forall o In rtitem.EmbeddedObjects
                  If ( o.Type = EMBED_ATTACHMENT ) _
                  And ( o.FileSize > MAX ) Then
                        fileCount = fileCount + 1
                        Call o.ExtractFile _
                        ( Path & Cstr(fileCount) )
                        Call o.Remove
                        Call doc.Save( True, True )
                  End If
            End Forall
      End If
End Sub
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9805534
Sorry for double post. The last one is better.

It does require some fine-tuning, which I am sure you can do.
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9805545
OK. Neat code now. Nearly complete in all respects.



'Detach2:

Option Public

Sub Initialize
      Dim sn As New NotesSession
      Dim doc As NotesDocument
      Dim rtitem As Variant
      Dim fileCount As Integer
      Dim fileName As String
      Dim fromName As NotesName
      Dim Path As String
      Const MAX = 100000
      
      fileCount = 0    
      Set doc = sn.DocumentContext
      Set fromName = New NotesName(doc.GetFirstItem("From").Text)
      Path = "C:\" + GetDomain("ranjeetrain@yaho.com") + "_Attachments\"
      Path = "C:\" + GetDomain(fromName.Addr822Phrase) + "_Attachments\"
      Set rtitem = doc.GetFirstItem( "Body" )
      If ( rtitem.Type = RICHTEXT ) Then
            Forall o In rtitem.EmbeddedObjects
                  If ( o.Type = EMBED_ATTACHMENT ) And ( o.FileSize > MAX ) Then
                        fileCount = fileCount + 1
                        Call o.ExtractFile ( Path & o.Source )
                  End If
            End Forall
      End If
End Sub



'
'
Function GetDomain (Byval strEMail As String) As Variant
      Msgbox stremail
      GetDomain = "Unknown"
      
      If strEMail = "" Then
            Exit Function
      End If
      
      Dim strMailID As String
      Dim containsAtSign As Variant
      Dim containsDot As Variant
      
      strMailId = Trim(strEMail)
      
      ' Check for the presence of "@" symbol from 2nd place
      containsAtSign = Instr(2, strMailID, "@")
      If containsAtSign < 2 Then
            Exit Function
      End If
      
      ' Check for the presence of "."  (dot) symbol from 4th place
      containsDot = Instr(4, strMailID, ".")
      If containsDot < 4 Then
            Exit Function
      End If
      
      If Len(strMailID) < 6 Then
            Exit Function
      End If
      
      GetDomain = Right(Left(strMailID, containsDot - 1), ContainsDot - ContainsAtSign)
End Function


~ Ranjeet Rain
0
 
LVL 19

Accepted Solution

by:
RanjeetRain earned 200 total points
ID: 9805568
Nearly perfect:




'Detach2:

Option Public

Sub Initialize
      Dim sn As New NotesSession
      Dim doc As NotesDocument
      Dim rtitem As Variant
      Dim fileName As String
      Dim fromName As NotesName
      Dim Path As String
      Const ATTR_DIRECTORY = 16
      Const EMBED_ATTACHMENT = 1454
      Const BasePath = "C:\Temp"
      
      fileCount = 0    
      Set doc = sn.DocumentContext
      Set fromName = New NotesName(doc.GetFirstItem("From").Text)
      Path = "C:\" + GetDomain("ranjeetrain@yaho.com") + "_Attachments"
      Path = BasePath & "\" + GetDomain(fromName.Addr822Phrase) + "_Attachments"
      On Error Resume Next
      If Dir(PATH, ATTR_DIRECTORY) <> PATH Then
            Mkdir Path
      End If
      On Error Goto 0
      
      Set rtitem = doc.GetFirstItem( "Body" )
      If ( rtitem.Type = RICHTEXT ) Then
            Forall o In rtitem.EmbeddedObjects
                  If ( o.Type = EMBED_ATTACHMENT ) Then
                        Call o.ExtractFile ( Path & "\" & o.Source )
                  End If
            End Forall
      End If
End Sub


'
'      Returns the domain part from a valid Internet address (RFC822)
'

Function GetDomain (Byval strEMail As String) As Variant
      GetDomain = "Unknown"
      
      If strEMail = "" Then
            Exit Function
      End If
      
      Dim strMailID As String
      Dim containsAtSign As Variant
      Dim containsDot As Variant
      
      strMailId = Trim(strEMail)
      
      ' Check for the presence of "@" symbol from 2nd place
      containsAtSign = Instr(2, strMailID, "@")
      If containsAtSign < 2 Then
            Exit Function
      End If
      
      ' Check for the presence of "."  (dot) symbol from 4th place
      containsDot = Instr(4, strMailID, ".")
      If containsDot < 4 Then
            Exit Function
      End If
      
      If Len(strMailID) < 6 Then
            Exit Function
      End If
      
      GetDomain = Right(Left(strMailID, containsDot - 1), ContainsDot - ContainsAtSign)
End Function




0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 24

Expert Comment

by:HemanthaKumar
ID: 9805775
1983,

Here is the sandbox code which does remove the attachment and creates a link into the mail db. In this agent add search to look for abc@abc.com in SendTo Field.

http://www-10.lotus.com/ldd/sandbox.nsf/ecc552f1ab6e46e4852568a90055c4cd/fe7542cd3b120e1b00256c38004a6a27?OpenDocument

~Hemanth
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9806497
The code I gave does all that was asked. As for removing the attachments, thats three more lines of code.

o.Remove ' remove attachemnt after o.ExtractFile
' and at the end
doc.save
doc.close
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9841694
ninteen83, did you try this code? Did you find any problems with this? Please let us know.
0
 
LVL 31

Expert Comment

by:qwaletee
ID: 9844134
Ranjeet,

If you were going to perfect the code, why did you post "early versions" three times before the final version?
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 9844205
You know someone could post a better code sooner than me ;-) So I just posted whatever I had at the hand :)

How is ur weekend going on like?
0
 
LVL 31

Expert Comment

by:qwaletee
ID: 9844226
RanjeetRain,
> How is ur weekend going on like?
The usual.  Windy.
0
 

Author Comment

by:ninteen83
ID: 9844556
Brothers ... I'm on my annual vacations .. so let me be back to my office

have fun ..
0
 
LVL 19

Expert Comment

by:RanjeetRain
ID: 10075960
ninteen83,

This thread has been open for a long time now. Are you looking for more inputs on this? If not, please close the question appropriately.
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

For users on the Lotus Notes 8 Standard client, this article provides information on checking the Java Heap size and adjusting it to half of your system RAM in attempt to get the Lotus Notes 8.x Standard client to run faster.  I've had to exercise t…
This is an old article, please see an updated version of this article, located here: http://www.experts-exchange.com/articles/23619/Notes-8-5x-Windows-7-Notes-info-and-tips.html
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now