Detach Attachment

Sorry, forgot to mention that if the agent could run on various files at once, could the agent create a seperate folder for each file and only drop the correct attachments in the corresponding newly created folder?

Check below links:
https://www.experts-exchange.com/questions/10345075/How-to-detach-attachments-in-notes.html?sfQueryTermInfo=1+detach+file
https://www.experts-exchange.com/questions/10255328/About-detach-attachments.html?sfQueryTermInfo=1+detach+file

https://www.experts-exchange.com/questions/10206185/Detach-1000s-of-files-at-once.html?sfQueryTermInfo=1+detach+file

https://www.experts-exchange.com/questions/20096249/Lotus-Script-for-Detaching-files.html?sfQueryTermInfo=1+detach+file

Hi madheeswar

Thanks for the links, but they do not quite get me there, the following code is what I am using at the moment but it only half works, what i want the code to do is to take say the value in the "contact" field and create a folder with this value and then put any attachments in that notes file that there may be.

-----------------------
Sub Initialize
      
      Const path = "C:\Detach\"
      Dim s As New notesSession
      Dim db As notesDatabase
      Set db = s.currentDatabase
      Dim docs As notesDocumentCollection
      Set docs = db.unprocessedDocuments
      Dim doc As notesDocument
      Set doc = docs.getFirstDocument
      Dim fileNames, fileObj As notesEmbeddedObject, dotPos As Integer, lastDotPos As Integer
      Do Until doc Is Nothing
            If Not doc.hasItem("$File") Then Goto skip
            fileNames = Evaluate("@AttachmentNames",doc)
            Forall filename In fileNames
                  Set fileObj = doc.getAttachment(filename)
                  lastDotPos = Len(filename)+1
                  dotPos = Instr(filename,".")
                  Do Until dotPos = 0
                        lastDotPos = dotPos
                        dotPos = Instr(dotPos+1,filename,".")
                  Loop
                  filename = Left(filename,lastDotPos-1) & " (" & doc.noteID & ")" & Mid(filename,lastDotPos)
                  fileObj.extractFile path & filename
            End Forall
skip:
            Set doc = docs.getNextDocument(doc)
      Loop
      
End Sub

-----------------------

The function you need to use is called Mkdir.

Here are a couple of functions that will make sure any directory exists.  You can add these to a library, then just call DirCreate(path & "\" & doc.GetItemValue("contact")(0)).  Be careful, though.  the "contact" field may contain invalid characters such as "?".

Public Sub DirCreate(Byval filePath As String)
      
      '/**
      ' * Creates a directory.
      ' * @param filePath A string containing the directory to create.  If filePath contains a path with nested directories that do not exist, this function will create all directories in the path.
      ' */
      
      Dim pathArray As Variant
      Dim temp As String
      Dim dirSep As String
      dirSep = "\"
      pathArray = Split(filePath, dirSep)
      Forall vElement In pathArray
            temp = temp & Cstr(vElement) & dirSep
            If (Not DirExists(temp)) Then Mkdir temp
      End Forall
      
End Sub


Public Function DirExists(dirName As String) As Variant
      
      '/**
      ' * Determines whether a directory exists.
      ' * @param dirName The path of the directory to check.
      ' * @return True if the directory exists.
      ' */
      
      Dim temp As String
      On Error Goto DONE
      Const ATTR_DIRECTORY = 16
      DirExists = (Dir$(dirName, ATTR_DIRECTORY) <> "")
      
DONE:
      Err = 0
      Exit Function
      
End Function

Hi Bill

That is about as clear as mud - sorry

Don't need to test for the directory existing. Just put an

on error 75 resume next

before the MkDir, then Let Err = 0 (and reset error checking afterwards)

You might also put an on error 4005 on the extractfile, just in case the mkdir error is not due to a preexisting folder.

Even if you use Bill's DirExists function, you should still check for error 75 and error 4005.

No idea how to do this

Sure, just paste my two functions into the "Declarations" module of your code, then change the Initialize module to this...

-----------------------
Sub Initialize
     
      Const path = "C:\Detach\"
      Dim s As New notesSession
      Dim db As notesDatabase
      Set db = s.currentDatabase
      Dim docs As notesDocumentCollection
      Set docs = db.unprocessedDocuments
      Dim doc As notesDocument
      Set doc = docs.getFirstDocument
      Dim fileNames, fileObj As notesEmbeddedObject, dotPos As Integer, lastDotPos As Integer
      Dim fullPath as string
      Do Until doc Is Nothing
            If Not doc.hasItem("$File") Then Goto skip
            fileNames = Evaluate("@AttachmentNames",doc)
            Forall filename In fileNames
                  Set fileObj = doc.getAttachment(filename)
                  lastDotPos = Len(filename)+1
                  dotPos = Instr(filename,".")
                  Do Until dotPos = 0
                        lastDotPos = dotPos
                        dotPos = Instr(dotPos+1,filename,".")
                  Loop
                  filename = Left(filename,lastDotPos-1) & " (" & doc.noteID & ")" & Mid(filename,lastDotPos)
                  fullPath = path & doc.GetItemValue("contact")(0)
                  Call DirCreate(fullPath)
                  fileObj.extractFile fullPath & "\" & filename
            End Forall
skip:
            Set doc = docs.getNextDocument(doc)
      Loop
     
End Sub

-----------------------

Hi Bill

That is now working, can you point me in the right direction to include the code to also delete the attachments.

Thanks

Hi Bill

That works realy well, thanks. However on testing I came across a problem, nothing to do with the code just the way we have the setup here.

We can have a number of client files (contact field) and if we run this code files some get overwriten, is there anyway of adding the value in the date field of "createdate" to concatenate the client name on the folder; for example: Jon Doe 23/12/2006 as the folder name?

Many thanks and last point I promise :-)

No problem.

There are several ways to ensure that the file names/paths are unique.  The method used depends on your application.  You could use "contact + date", but that does not seem unique enough to me (you might have two documents created on the same day with the same contact).  If this is what you need, though, it can be done.  We just need to make sure that the folder has a valid name.  I use a function called "StrFixFilename" to accomplish this (included below) Here's an example using "contact + date":

-----------------------
fullPath = path & doc.GetItemValue("contact")(0) & Format(doc.Created, "DD_MM_YYYY")
fullPath = StrFixFilename(fullPath, "_")
-----------------------

... And here's the function to ensure that the filename is valid.

-----------------------
Public Function StrFixFilename(Byval fileName As String, Byval replaceChar As String)
      
      '/**
      ' * Replaces invalid characters in a filename with a specific character.
      ' * @param filePath The file name to fix.
      ' * @param replaceChar The character to use for replacing invalid characters.
      ' * @return A valid filename.
      ' */
      
      Dim badChars As Variant
      badChars = Split({\,/,:,*,?,",<,>,|}, ",")
      Forall badChar In badChars
            fileName = Replace(fileName, badChar, replaceChar)
      End Forall
      StrFixFilename = fileName
      
End Function
-----------------------

I usually use the document unique id since it is guaranteed to be unique within the database.  This way, if you run the agent more than once, the files will be always be extracted to the same folder.  Also, the document unid will always be a valid pathname.  If this is what you want, just set fullPath like this...

fullPath = path & doc.UniversalID

Bill,

We think mostly alike here. I only used NoteID instead of UniversalID because one looks more horrible than the other ;)

OK, Bill the last two solutions did not work, i suspect an easy fix, but i used a bit of qwaletee's code and it now works as i would have liked.

Thanks to you both, points awarded as fairly as i can, i hope it is ok.