Solved

Extracting Attachments from OLE STORAGE HOST from within $file

Posted on 2006-11-29
21
2,200 Views
Last Modified: 2013-11-17
Hi,

I am trying to extract attachments from two different databases. I have gotten the following script from one of the postings here which is working fine on one of the databases. However, when I run the same script on the docs in the other database, I am getting a "can not extract object...." error. I nnoticed that the "$file" field has HOST: OLE STORAGE in the docs of the database where this script is NOT working but has HOST: MSDOS/OS2 in the docs of the database where it IS working. Can you please advise what do I need to change in this script for it to work for OLE objects? These are all Excel, Word, and like docs that are atthached in the Body of the body of the docs. I am not a programmer, please be very specific.

Thank you in advance for your help.
Shyam

Here's the script:

Sub Initialize
      Const path = "C:\BULK2\"
      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
0
Comment
Question by:ShyamDalmia
  • 8
  • 7
  • 4
21 Comments
 
LVL 63

Expert Comment

by:SysExpert
ID: 18045213
Either this is a linked document or one that may require te original application to see/ change

I am not sure, but within the object you may be able to try and extract the contents.

I hope this helps !
0
 
LVL 63

Expert Comment

by:SysExpert
ID: 18045599
also see

Examples: Working with attachments and embedded objects in LotusScript classes   - in the Designer Help

  1.      This agent extracts the file attachments in the Body item of the current document using NotesRichTextNavigator methods to get the attachments.
REM Run this against a selected document that has Body field
REM Body field should contain file attachments
Sub Initialize
  Dim session As NotesSession
  Dim db As NotesDatabase
  Dim dc As NotesDocumentCollection
  Dim doc As NotesDocument
  Dim body As NotesRichTextItem
  Dim rtnav As NotesRichTextNavigator
  Dim att As NotesEmbeddedObject
  Set session = New NotesSession
  Set db = session.CurrentDatabase
  Set dc = db.UnprocessedDocuments
  Set doc = dc.GetFirstDocument
  If Not doc.HasEmbedded Then Exit Sub
  Set body = doc.GetFirstItem("Body")
  Set rtnav = body.CreateNavigator
 
  REM Get attachments
  If rtnav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
    Do
      Set att = rtnav.GetElement()
      filepath$ = "C:\Files\" & att.Source
      Call att.ExtractFile(filepath$)
      Print filepath$ & " extracted"
    Loop While rtnav.FindNextElement()
  End If
End Sub
  2.      This agent extracts the file attachments in the Body item of the current document using NotesRichTextItem.EmbeddedObjects property to get the attachments.
REM Run this against a selected document that has Body field
REM Body field should contain file attachments
Sub Initialize
  Dim session As NotesSession
  Dim db As NotesDatabase
  Dim dc As NotesDocumentCollection
  Dim doc As NotesDocument
  Dim body As NotesRichTextItem
  Set session = New NotesSession
  Set db = session.CurrentDatabase
  Set dc = db.UnprocessedDocuments
  Set doc = dc.GetFirstDocument
  If Not doc.HasEmbedded Then Exit Sub
  Set body = doc.GetFirstItem("Body")
 
  REM Get attachments
  Forall att In body.EmbeddedObjects
    If att.Type = EMBED_ATTACHMENT Then
      filepath$ = "C:\Files\" & att.Source
      Call att.ExtractFile(filepath$)
      Print filepath$ & " extracted"
    End If
  End Forall
End Sub
  3.      This form action example displays properties of all the embedded objects in a document.
Sub Click(Source As Button)
  Dim workspace As New NotesUIWorkspace
  Dim uidoc As NotesUIDocument
  Dim doc As NotesDocument
  Dim item As Variant
  Set uidoc = workspace.CurrentDocument
  Set doc = uidoc.Document
  Set item = doc.GetFirstItem("Body")
  Forall embobj In item.EmbeddedObjects
    verbs = "No verbs"
    Select Case embobj.Type
    Case EMBED_OBJECTLINK : _
    embobjType = "Object link"
    Case EMBED_ATTACHMENT : _
    embobjType = "Attachment"
    Case EMBED_OBJECT : embobjType = "Object"
      verbs = "Verbs:"
      Forall verb In embobj.Verbs
        verbs = verbs & " " & verb
      End Forall
    End Select
    Messagebox "Name: " & embobj.Name & Chr(10) _
    & "Class: " & embobj.Class & Chr(10) _
    & "File size: " & embobj.FileSize & Chr(10) _
    & "Type: " & embobjType & Chr(10) & verbs
  End Forall
End Sub
  4.      This form action example activates the first or only embedded object in a document.
Sub Click(Source As Button)
  Dim workspace As New NotesUIWorkspace
  Dim uidoc As NotesUIDocument
  Dim doc As NotesDocument
  Dim item As Variant
  Set uidoc = workspace.CurrentDocument
  Set doc = uidoc.Document
  Set item = doc.GetFirstItem("Body")
  If Isempty (item.EmbeddedObjects) Then
    Messagebox "No embedded object in document"
    Exit Sub
  End If
  If item.EmbeddedObjects(0).Type <> EMBED_OBJECT Then
    Messagebox "Object not an embedded object"
    Exit Sub
  End If
  Call item.EmbeddedObjects(0).Activate(True)
End Sub

See Also  Working with attachments and embedded objects in LotusScript classes    in the Design Help


0
 
LVL 63

Expert Comment

by:SysExpert
ID: 18045616
As mentioned in Working with attachments and embedded objects in LotusScript classes  

Extracting depends on whether they are embedded or attached, and also on the type of file/attachment.

I hope this helps !
0
 

Author Comment

by:ShyamDalmia
ID: 18051975
Hi SysExpert,

Thank you so much for trying to help me. I sincerely appreciate it. However, I tried running the first two example agents you sent to me as LotusScript Agents on the docs in my database but they both (at different attempts) will run for a fraction of a second and will NEITHER produce any error(s) and NOR any results in the C:\Files\ path on my local machine.

I then created an Action button in the form and clicked on it from within the first doc of the database and the following are the results I got in a dialog/message box:

Name: Microsoft Excel Spreadsheet
Class: Excel.Sheet.8
File Size: 0
Type: Object
Verbs: &Edit &Open

Can you please tell me what am I doing wrong?

Note: I believe the database is designed in 4.5 (but not 100% sure) and I am using R6.5 on my client as well as the Domino server.

Thanks again.
Shyam
0
 
LVL 18

Expert Comment

by:marilyng
ID: 18059724
Hi ShyamDalmia,


I got this from sandbox, which is a detach and remove documents agent.   See if this works for you.  It will prompt you for a detachment location folder.  It will also add a link in the mail file to the detached path.

'Tools\Detach and Remove Attachments:

Option Public
Option Declare
%INCLUDE "lsconst.lss"
%INCLUDE "lserr.lss"

%REM
These declarations are in support of the MSWindows APIs that are used by this
agent.  This means that this agent will only work on Win32 clients.
%END REM
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (Byval hwndOwner As Long, _
Byval nFolder As Long, ppidl As Long) As Long
Const CSIDL_DRIVES = &H11
Type BROWSEINFO
    hwndOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpbi As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(Byval pidl As Long, Byval pszPath As String) As Long
Declare Sub CoTaskMemFree Lib "ole32.dll" (Byval pv As Long)

' Returns a file-path in the older DOS 8.3 notation without spaces
Declare Function GetShortPathNameA Lib "kernel32" (Byval lpszLongPath As String,_
Byval lpszShortPath As String, Byval cchBuffer As Long) As Long

%REM
Other global variables
%END REM
Public Const ENV_FOLDER_LOCATION = "DRL_FolderLocation"

Sub Initialize
   
    Dim session As New NotesSession
    Dim ws As New NotesUIWorkspace
    Dim view As NotesUIView
    Dim doc As NotesDocument
    Dim db As NotesDatabase
    Dim dc As NotesDocumentCollection
   
    Dim counter As Integer          'attachment counter
    Dim iDocsProcessed As Integer       'processed message counter
    Dim dupc As Integer            'duplicated filenames counter
    Dim strDetachFolder As String 'receives name of temporary file path
    Dim strMessage As String
    Dim lBoxType As Long
    Dim iErr As Integer
    Dim iTaskId As Integer
    Dim iTotalAttachments As Integer
    Dim iNumDocAttachments As Integer
    Dim iTotalDocuments As Integer
    Dim iPercentCompleted As Integer
   
    ' General errors get trapped here
    On Error Goto HandleError
   
    ' This on error traps the error that results when the agent attempts to
    ' open the collection from within a document rather than a view
    On Error ErrObjectVariableNotSet Goto NoSelected
   
    ' Ensure we are using windows 32... if not then say goodbye.
    If session.Platform <> "Windows/32" Then
        strMessage = "Sorry, this only works on a Windows/32 platform at the moment!"
        lBoxType = MB_OK+MB_ICONEXCLAMATION
        Messagebox strMessage, lBoxType, "Warning"
        Exit Sub
    End If
   
    ' Do some initial stuff to make sure we are in a view and at least
    ' one document is selected before we go to the trouble of asking
    ' the user anything
    Set db = session.CurrentDatabase
    Set view = ws.CurrentView
    ' This statement will produce an error if the user is currently in a document
    ' rather than the view.
    Set dc = view.Documents
   
    'if no document selected
    If dc.Count < 1 Then
        strMessage = "You must have selected at least one document before doing this action!"
        lBoxType = MB_OK+MB_ICONEXCLAMATION
        Messagebox strMessage, lBoxType, "Warning"
        Exit Sub
    End If
   
    ' Get the folder to detach attachments into
    If Not fGetDetachFolder(session, strDetachFolder) Then
        Exit Sub
    End If
   
    iTotalDocuments = dc.Count
    iDocsProcessed = 0
   
    Set doc = dc.GetFirstDocument
    While Not doc Is Nothing
        iDocsProcessed  = iDocsProcessed + 1
        'detach each attachment
        iNumDocAttachments = fDetachRemoveAndLink(session, doc, strDetachFolder)
        iTotalAttachments = iTotalAttachments + iNumDocAttachments
        iPercentCompleted = Int((iDocsProcessed / iTotalDocuments) * 100)
        Print Cstr(iDocsProcessed) & " out of " & Cstr(iTotalDocuments) & _
        " (" & Cstr(iPercentCompleted) & "%)"
        Set doc = dc.GetNextDocument(doc)
    Wend
    strMessage = Cstr(iDocsProcessed) & " document(s) processed." & Chr(10) & _
    "There were a total of " & Cstr(iTotalAttachments) & Chr(10) & _
    "detached into the folder: " & strDetachFolder
    lBoxType = MB_OK
    Messagebox strMessage, lBoxType, "Finished!"
   
    Call ws.ViewRefresh( )
   
    Exit Sub
   
HandleError:
    iErr = Err()
    strMessage = "Please make sure that the folder: " & strDetachFolder & " is available."
    lBoxType = MB_OK+MB_ICONSTOP
    Messagebox strMessage, lBoxType, "Warning"
    Exit Sub
   
NoSelected:
    iErr = Err()
    strMessage = "This action must only be taken while in a view!" & _
    Chr(13) & "Use the Attachment, Detach All... action while in a document!"
    lBoxType = MB_OK+MB_ICONEXCLAMATION
    Messagebox strMessage, lBoxType, "Warning"
    Exit Sub
End Sub
Function fGetShortPathName(longpath As String) As String
   
    Dim s As String
    Dim i As Long
   
    i = Len(longpath) + 1
    s = String(i, 0)
    GetShortPathNameA longpath, s, i
   
    fGetShortPathName = Left$(s, Instr(s, Chr$(0)) - 1)
   
End Function
Function fGetFolderLocation() As String
    Dim bi As BROWSEINFO  ' structure passed to the function
    Dim pidl As Long  ' PIDL to the user's selection
    Dim physpath As String  ' string used to temporarily hold the physical path
    Dim retval As Long  ' return value
    Dim vbNullChar As String
   
    vbNullChar = Chr(0)
     ' Initialize the structure to be passed to the function.
        ' The owner of the dialog box.
    bi.hwndOwner = 0
     ' Specify the My Computer virtual folder as the root.
    retval = SHGetSpecialFolderLocation(0, CSIDL_DRIVES, bi.pidlRoot)
     ' Make room in the buffer to get the [virtual] folder's display name.
    bi.pszDisplayName = Space(260)
     ' Message displayed to the user.
    bi.lpszTitle = "Please choose a folder."
     ' Nothing else needs to be set.
    bi.ulFlags = 0
    bi.lpfn = 0
    bi.lParam = 0
    bi.iImage = 0
     ' Open the Browse for Folder dialog box.
    pidl = SHBrowseForFolder(bi)
     ' If the user selected something, display its display name
     ' and its physical location on the system.
    If pidl <> 0 Then
          'Remove the empty space from the display name variable.
        bi.pszDisplayName = Left(bi.pszDisplayName, Instr(bi.pszDisplayName, vbNullChar) - 1)
          'Debug.Print  "The user selected: "; bi.pszDisplayName
          'If the folder is not a virtual folder, display its physical location.
        physpath = Space(260)
        retval = SHGetPathFromIDList(pidl, physpath)
        If retval = 0 Then
            'Debug.Print "Physical Location: (virtual folder)"
        Else
               ' Remove the empty space and display the result.
            physpath = Left(physpath, Instr(physpath, vbNullChar) - 1)
                        'Debug.Print "Physical Location: "; physpath
        End If
          ' Free the pidl returned by the function.
        CoTaskMemFree pidl
    End If
   
     ' Whether successful or not, free the PIDL which was used to
     ' identify the My Computer virtual folder.
    CoTaskMemFree bi.pidlRoot
    ' Return the physpath value
    fGetFolderLocation = physpath
   
End Function

Function fGetDetachFolder(session As NotesSession, strDetachFolder As String) As Variant
   
    On Error Goto HandleError
   
    Dim strMessage As String
    Dim lBoxType As Long
    Dim lAnswer As Long
   
    fGetDetachFolder = False
   
    'get current saved folder
    strDetachFolder = session.GetEnvironmentString( ENV_FOLDER_LOCATION )
   
    'if the folder doesn't exist, show folder location window.
    If Isempty(strDetachFolder) Or Len(strDetachFolder) < 2 Then
        strDetachFolder = fGetFolderLocation()
        If Len(strDetachFolder) < 2 Then
            Exit Function
        End If
        'save strDetachFolder in to .ini
        Call session.SetEnvironmentVar( ENV_FOLDER_LOCATION, strDetachFolder )    
    Else
        'check the existance of the current folder, if it doesn't exist, prompt.
        If fFileExists(strDetachFolder) Then
            strMessage = "Current detach folder: "& strDetachFolder & " doesn't exist"
            lBoxType = MB_OK + MB_ICONSTOP
            Messagebox strMessage, lBoxType, "Detach Folder"
            lAnswer = IDNO
        Else
            strMessage = "Use current default folder: " & strDetachFolder & "?"
            lBoxType = MB_YESNO + MB_ICONQUESTION
            lAnswer = Messagebox(strMessage, lBoxType, "Detach Folder")
        End If
       
        'if no current default folder, prompt for folder location window.
        If lAnswer = IDNO Then
            strDetachFolder = fGetFolderLocation()
            'if the input string less than 2-character, stop
            If Len(strDetachFolder) < 2 Then
                Exit Function
            End If
            'save strDetachFolder in to .ini
            Call session.SetEnvironmentVar( ENV_FOLDER_LOCATION, strDetachFolder )            
        End If        
    End If
   
    fGetDetachFolder = True
   
    Exit Function
   
HandleError:
    strMessage = "Error in fGetDetachFolder: (" & Err & ") " & Error & " at line: " & Erl
    lBoxType = MB_OK + MB_ICONSTOP
    Messagebox strMessage, lBoxType, "Error!"
    Exit Function
   
End Function

Function fDetachRemoveAndLink(session As NotesSession, doc As NotesDocument, _
strDetachFolder As String) As Integer
   
    On Error Goto HandleError
   
    Dim objAttachment As NotesEmbeddedObject
    Dim rtStyleText As NotesRichTextStyle
    Dim rtStyleSep As NotesRichTextStyle
    Dim rtStyleLink As NotesRichTextStyle
    Dim rtitem As Variant
    Dim iCounter As Integer
    Dim strExtractName As String
    Dim strPath As String
    Dim lAnswer As Long
    Dim iFilenum As Integer
    Dim lBoxTYpe As Long
    Dim strMessage As String
    Dim strNewLink As String
    Dim strNamePart As String
    Dim strExtPart As String
   
    fDetachRemoveAndLink = 0
   
    iCounter = 0
   
    ' Look for rich text items in the document.  Use the first rich text
    ' item found for rtitem - unless we find one named "Body" which will
    ' supercede any rich text item found thus far.
    ' If we don't find a rich text item then quit out of this document
    Set rtitem = Nothing
    Forall item In doc.Items
        If item.Type = RICHTEXT Then
            If rtitem Is Nothing Then
                Set rtitem = doc.GetFirstItem(item.Name)
            Elseif Strcompare(item.Name, "body", 5) = 0 Then
                Set rtitem = doc.GetFirstItem(item.Name)
            End If
        End If
    End Forall
   
    ' If we have not found a rich text item to use then scream and quit
    ' this document
    If rtitem Is Nothing Then
        strMessage = "Unable to locate any rich text items to hold the links " & _
        "to the attachments that may be removed.  Cannot process this document " & _
        "with NoteId of: " & fFormatNoteId(doc.NoteId)
        lBoxType = MB_OK+MB_ICONEXCLAMATION
        Messagebox strMessage, lBoxType, "No RichText Item Found"
        Exit Function
    End If
   
    ' Iterate through each of the document's items looking for attachments
    Forall item In doc.Items
        If item.Type = Attachment Then
            ' Now that we have an attachment, get the embedded object
            ' associated with it.  The first thing in the Values array
            ' is the name of the attachment.
            Set objAttachment = doc.GetAttachment(item.Values(0))
            iCounter = iCounter + 1
           
            'get the attachment filename
            strExtractName = objAttachment.Name
           
            'generate a unique path for the file to be detached to - this
            'involves checking for the existence of a file with the same name
            'and incrementing a counter prepended to the filename until a
            'name is found that does not exist in the detach folder.
            strPath = strDetachFolder & "\" & strExtractName
            iFilenum = 1
            While fFileExists(strPath)
                strNamePart = Strleftback(strExtractName, ".", 5)
                strExtPart = Strrightback(strExtractName, ".", 5)
                strPath = strDetachFolder & "\" & strNamePart & "_" & Cstr(iFilenum) & "." & strExtPart
                iFilenum = iFilenum + 1
            Wend
            ' Detach the attachment to the unique path
            Call objAttachment.ExtractFile(strPath)
           
            ' Now create the link to the detached file so that we will
            ' be able to get to it from this document
            ' The link will be in the format:
            ' "Removed Attached file: <attachment> to [file:\\<pathtodetachedfile>]"
           
            ' Get the rich text item in which to append the links
            'Set rtitem = doc.GetFirstItem("Body" )
           
            ' Create the rich text styles
            Set rtStyleText = session.CreateRichTextStyle
            Set rtStyleSep = session.CreateRichTextStyle
            Set rtStyleLink = session.CreateRichTextStyle
           
            ' Initialize the styles for the three pieces of each linked file
            rtStyleText.Bold = False
            rtStyleText.NotesColor = COLOR_DARK_BLUE
            rtStyleText.Underline = False
            rtStyleText.NotesFont = FONT_HELV
            rtStyleText.FontSize = 8
            rtStyleSep.Bold = False
            rtStyleSep.NotesColor = COLOR_BLACK
            rtStyleSep.Underline = False
            rtStyleSep.NotesFont = FONT_HELV
            rtStyleSep.FontSize = 8
            rtStyleLink.Bold = False
            rtStyleLink.NotesColor = COLOR_BLUE
            rtStyleLink.Underline = True
            rtStyleLink.NotesFont = FONT_HELV
            rtStyleLink.FontSize = 8
           
            ' Build the string to be used in the link
            strNewLink = "file:\\" & fGetShortPathName(strPath)
           
            ' Append the link to the rich text field
            If iCounter = 1 Then
                Call rtitem.AddNewLine( 2 )
            End If
            Call rtitem.AppendStyle( rtStyleText )
            Call rtitem.AppendText( "Removed attached file: " & strExtractName & " to " )
            Call rtitem.AppendStyle( rtStyleSep )
            Call rtitem.AppendText( " --> [ " )
            Call rtitem.AppendStyle( rtStyleLink )
            Call rtitem.AppendText( strNewLink )
            Call rtitem.AppendStyle( rtStyleSep )
            Call rtitem.AppendText( " ]" )
            Call rtitem.AddNewLine( 1 )
           
            ' Remove the attachment from the document
            Call objAttachment.Remove
        End If
    End Forall
   
    ' Save the document so that the changes we just made will be retained
    Call doc.Save(True, False, True)
   
    fDetachRemoveAndLink = iCounter
   
    Exit Function
   
HandleError:
    strMessage = "Error in fDetachRemoveAndLink: (" & Err & ") " & Error & " at line: " & Erl
    lBoxType = MB_OK + MB_ICONSTOP
    Messagebox strMessage, lBoxType, "Error!"
    Exit Function
   
End Function
Function fFileExists(strPath As String) As Variant
   
    fFileExists = Not (Dir(strPath) = "")
   
End Function
Function fFormatNoteId(strN As String) As String
   
    ' Format the NoteId so that it is 8 characters with leading 0's
    If Len(strN) = 8 Then
        fFormatNoteId = strN
    Else
        fFormatNoteId = String(8-Len(strN), "0") & strN
    End If
   
End Function





Regards!
0
 

Author Comment

by:ShyamDalmia
ID: 18111340
Dear Maryling and others,

The various pieces of code I have received so far works great for regular "ATTACHMENTS. However, in my case, I have documents that DO NOT have regular attachments, but as "OLE Objects (the documents are actually EMBEDDED into the documents). Can someone PLEASE provide a sample code which dumps all these EMBEDDED OLE documents to the local drive as we are trying to migrate from Notes to Exchange and need these docs migrated to another system?

Someone PLEASE HELP! I am gettinng very desparate!

Thanks in advance
Shyam
0
 
LVL 18

Expert Comment

by:marilyng
ID: 18112338
It's not elegant, and the problem with excel and office files is the macros.  If macros exist, then a messagebox opens and asks if you want to enable macros, but only if you set the activate (true).  Otherwise it just will not create the object for security reasons.
Also, you have to create the filename for the object.. i.e. is the object a worksheet, word document, visio drawing.  To figure out the possibilities and add to the select case, you need to get a sampling and open the document, right click on it to get the object type string and then create another select case statement in this agent, with the appropriate filename and extension.

Embedded objects don't recognize images.. i.e. .jpg, .gif  unless they are attached, and not embedded.

When an OLE object is embedded, the only thing Notes (or other applications) store is the program that created it, so it can open the program.  It does not save the original filename.  Therefore the program must be installed for this code to work, and the saved files are generically named:  Word Document, Excel Worksheet, Visio Drawing.. not much help if you want to associate the object with a particular email thread.  You could possible create the name from the email properties.. i.e. username, subject.

But what you're going to get is disconnected and out of context files. For example, how would I know if  Excelworksheet 2005-11-9.xls is the Acme Quote Request?  If it were me, I would simply print the email threads to PDF.  Acrobat does this rather well, and you get indexing and context, plus bookmarks.

---------
Another way is to install DAMO on the current Notes Server, and have the users use Outlook to access their Notes Email Database and then copy those to Exchange, or use a Microsoft Exchange migration tool to move the emails to Exchange.  
----------------------

Agent Information
Name:      Detach and Remove Embedded
Last Modification:      12/10/2006 07:17:06 PM
Comment:      [Not Assigned]
Shared Agent:      Yes
Type:      LotusScript
State:      Enabled
Trigger:      Manually From Actions Menu
Acts On:      Selected documents


LotusScript Code:
Option Public
Option Declare
Sub Initialize
      Dim session As New NotesSession
      Dim db As NotesDatabase
      Dim doc As NotesDocument
      Dim collection As NotesDocumentCollection      
      Set db = session.currentdatabase
      Set collection = db.UnprocessedDocuments
      Dim detachfolder As String
      Dim fileExt As String
      Dim filename As String
      Dim thisName As String
      Dim oleobj As Variant
      detachfolder = "c:\Temp"
      Dim rtitem As Variant
      Dim filecount As Integer
      Dim Processed As Integer
      FileCount = 0
      If collection.Count < 1 Then
            Msgbox "Sorry, there were no documents selected",,"Nothing Selected"
            Exit Sub
      End If
      Set doc = collection.GetFirstDocument
      While Not doc Is Nothing
            Filename = ""
            Set rtitem = doc.GetFirstItem( "Body" )
            If ( rtitem.Type = RICHTEXT ) Then
                  Forall o In rtitem.EmbeddedObjects                        
                        If o.Type =  EMBED_ATTACHMENT Then
                              thisName = o.Name                              
                              Filename = detachFolder +  "\" + o.name + "_" + Cstr(fileCount  + 1)
                              Print "Processing: " + filename
                              If okToSave(filename) Then
                                    Call o.ExtractFile (Filename )
                                    Call o.Remove
                                    rtItem.addnewline(1)
                                    rtItem.appendText "Embedded file removed to:  " + Filename
                                    rtItem.addnewline(1)
                                    rtItem.appendText "Removed on:  " + Format(Now) + " by  " + session.commonusername
                                    If doc.HasItem("FileExportError") Then
                                          doc.RemoveItem("FileExportError")
                                    End If
                                    Call doc.Save( True, False, False )
                                    fileCount = fileCount + 1                                    
                              Else
                                    Msgbox "Problem saving: " + filename,,"Unable to Save"
                                    doc.FileExportError = "PROCESS MANUALLY"
                                    doc.save True, False, False
                              End If
                        End If
                        If o.Type = EMBED_OBJECT Then
                              thisName = o.name
                              Select Case Lcase(o.name)
                              Case Lcase("Microsoft Office Excel Worksheet")                                    
                                    Filename =DetachFolder +  "\ExcelWorksheet" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".xls"
                              Case Lcase("Microsoft Word Document")
                                    Filename =DetachFolder +  "\WordDocument" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".doc"
                              Case Lcase("Microsoft Visio Drawing")
                                    Filename =DetachFolder +  "\Visio Drawing" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".vsd"
                              Case Else
                                    Filename =DetachFolder +  "\Unknown File" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".rtf"
                              End Select      
                              Print "Processing: " + filename
                              If Len(filename)> 1 Then
                                    If okToSave(filename) Then                                          
                                          On Error Goto Handle_Error
                                          Set oleObj = o.Activate (False)            
                                          If Not oleObj Is Nothing Then
                                                Call oleObj.SaveAs(fileName)
                                                Msgbox  "File Saved as: " + filename,,o.name
                                                Call oleObj.Close      
                                                fileCount = fileCount + 1
                                                rtItem.addnewline(1)
                                                rtItem.appendText "Embedded File saved to:  " + FileName
                                                rtItem.addnewline(1)
                                                rtItem.appendText "Saved to Disk on: " + Format(Now) + " by  " + session.commonusername
                                                If doc.HasItem("FileExportError") Then
                                                      doc.RemoveItem("FileExportError")
                                                End If
                                                Call doc.Save( True, False, False )
                                          Else
                                                Msgbox "Unable to open File: " + filename + " you may have to process this manually",,"File Save Failed"
                                                doc.FileExportError = "PROCESS MANUALLY"
                                                doc.save True, False, False
                                          End If            
                                    Else
                                          Msgbox "Problem saving: " + filename,,"Unable to Save"
                                    End If
                              End If
                        End If                        
                  End Forall            
            End If            
            Processed = Processed + filecount
            fileCount = 0
            Set doc = collection.GetNextDocument(doc)
      Wend
      Msgbox "Finished processing: " + Cstr(Processed) + " files" + Chr(13) + _
      "Please check: " + detachFolder + " for the files",,"Finished"
      Exit Sub
Handle_Error:
      On Error Goto 0
      Msgbox "Sorry, there was an error processing this request: " + thisName + _
      " Error: " + Error$ + "-" + Str(Err),,"Error processing File"
      Resume Next
      Exit Sub
End Sub
Sub Terminate
End Sub
Function okToSave(strPath As String) As Boolean
      Dim tmpFile As String
      Dim result As Boolean
      result = False
      If strPath="" Then Exit Function
      On Error Goto NoFile_Error      
      tmpFile = Dir$(strPath)
      If Len(tmpFile)<>0 Then result = True
      OktoSave = False
      If result Then
            Dim ans As Integer
            ans = Msgbox ("The File: " + strPath + " already exists.  Did you want to overwrite it?",36,"File already exists")
            If ans = 6 Then
                  Kill strPath
                  OktoSave = True
                  Exit Function                  
            End If
      Else
            OKToSave = True
      End If
      Exit Function
NoFile_Error:
      Err = 0
      result = False
      Exit Function
End Function
0
 
LVL 63

Expert Comment

by:SysExpert
ID: 18112371
The fact that you received this info, may mean that you can not detach these, only open and Edit ( based on the Verbs option ).
You may need to open them in the native program and then save them from there.


Name: Microsoft Excel Spreadsheet
Class: Excel.Sheet.8
File Size: 0
Type: Object
Verbs: &Edit &Open
 
I hope this helps !
0
 
LVL 18

Expert Comment

by:marilyng
ID: 18112484
Sorry, sysExpert, your point???  What info do you mean?  Did you not refresh your quickpost and read my SOLUTION???

You CAN detach them.  

The only problem you will have is the macros, at that point a dialog box opens asking if you want to enable or disable macros.  

I tested on three file types: word, excel and visio.  About the only thing I would add to the code I posted that does this is doc.NoteID:

Filename =DetachFolder +  "\WordDocument" + doc.NoteID + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".doc"

So you don't keep overwriting different files with the same filename.

You know, I am always embarrassed everytime I say, "This cannot be done.."  by someone who invariably pipes up with a solution.   I try to avoid absolutes, only because I can't possibly know everything or every workaround.  ;)
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 63

Expert Comment

by:SysExpert
ID: 18119944
I didn't see your previous post marilyng before posting mine ;  and I did not mention any absolutes. Pleae reread my last post.

0
 
LVL 18

Expert Comment

by:marilyng
ID: 18120010
Yeah, it dawned on me that that you didn't see it.   But Mike, I'm not following your logic here.  Was that an example of the embedded object properties?  If so, what to do with that information?  

0
 
LVL 63

Expert Comment

by:SysExpert
ID: 18120239
Well based on what little I can figure out , the verbs are the actions allowed, so he can only open or edit, not directly save or detach.

Again this is not tested.

So as you mentioned you have to Open the object with the program designed for the embedded object and then save it with a name.

AUtomatically doing this is not going to be easy unless you use an automated keyboard macro program or use a good scripting language, and grab or generate the name automatically, and also assume that all the programs save a file the same way .

Not fun.

0
 
LVL 18

Expert Comment

by:marilyng
ID: 18124841
SaveAs is available once the activate is called.    Code I posted is tested for those file types.
0
 
LVL 63

Expert Comment

by:SysExpert
ID: 18125309
Great, but what happens if it is an Embedded PDF or some non MS program that does not use Save As.

I guess that ShyamDalmia is going to have to take and use what will work in most cases and manually handle the rest.

0
 
LVL 18

Expert Comment

by:marilyng
ID: 18127644
PDF's will be problematic, unless you have the full acrobat installed, any other program running on the machine will function with SAVEAS, again images don't register as embedded objects.  The current code marks the document that could not be "read" which you can then collect in a view and manually process.

Only other option is to purchase a 3rd party solution.

0
 

Author Comment

by:ShyamDalmia
ID: 18191923
Dear SysExpert and MariLyng,

Thank you once again for your attempts to help me. I am sorry, I wasn't able to try the code until this morning. Here are the results:

I ran the code MariLyng posted last posted as:

Agent Information
Name:     Detach and Remove Embedded
Last Modification:     12/10/2006 07:17:06 PM
Comment:     [Not Assigned]
Shared Agent:     Yes
Type:     LotusScript
State:     Enabled
Trigger:     Manually From Actions Menu
Acts On:     Selected documents

I executed the agent on the very first document in the database which has three embedded documents and I can see waht they are looking at the doc. One is an Excel sheet as OLE, 2nd is a Word doc as an OLE, and the last one again is an Excel worksheet as an OLE.

The agent saved all three files to the c:\Temp. However, I can open the one that is saved as a Word doc fine within the Word program and actually read it in English but the other two are first of all saved as "Unkwown" (but has Word icon associated with them) and whn I try to open them in either Excel or Word, I see a bunch of gobliguke (strange characters) and a Conversion dialog box comes and no matter what I select to convert the file to its not readable in English.

What does this all mean please? And is there a quick fix to this problem?

Thanks again.
ShyamDalmia
0
 
LVL 18

Accepted Solution

by:
marilyng earned 125 total points
ID: 18192108
If you open the notes document, and right click on the OLE object and select properties, a properties dialog box will pop up.  The "I" tab will show you the exact object origin, i.e. "Microsoft Office Excel Worksheet".

The code I posted resolves three common OLE types, with a fourth case else, which it labels as "unknown":

Select Case Lcase(o.name)
        Case Lcase("Microsoft Office Excel Worksheet")                              
                 Filename =DetachFolder +  "\ExcelWorksheet" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".xls"
         Case Lcase("Microsoft Word Document")
                  Filename =DetachFolder +  "\WordDocument" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".doc"
         Case Lcase("Microsoft Visio Drawing")
                  Filename =DetachFolder +  "\Visio Drawing" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".vsd"
 
        'THIS IS WHEN THE OBJECT NAME DOESN'T MEET THE ABOVE NAMES... IT SAVES TO A RICH TEXT FILE.
         Case Else
                  Filename =DetachFolder +  "\Unknown File" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".rtf"
End Select    


-------
What this means is that the embedded object didn't match the exact wordage of what I initially trapped for:
Microsoft Office Excel Worksheet,
Microsoft Word Document,
Microsoft Visio Drawing

And since it had SOME information in the OLE properties, it resolved it to "unknown file.rtf"  which would associate it on your system as a Microsoft word document.


You need to open the document and right click on those two objects, get the object names and add the appropriate "case" statement to the code with the appropriate filename.  for instance:


If the object properties for the OLE file is: "Excel Worksheet" then add:

Case Lcase("Microsoft Office Excel Worksheet")                              
        Filename =DetachFolder +  "\ExcelWorksheet" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".xls"
Case Lcase("Microsoft Word Document")
         Filename =DetachFolder +  "\WordDocument" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".doc"
Case Lcase("Microsoft Visio Drawing")
         Filename =DetachFolder +  "\Visio Drawing" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".vsd"
Case lcase("Excel Worksheet")
          Filename =DetachFolder +  "\ExcelWorksheet" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".xls"

---------------
Or

----------
Case Lcase("Microsoft Office Excel Worksheet"),lcase("Excel Worksheet")                              
        Filename =DetachFolder +  "\ExcelWorksheet" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".xls"

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

The Object property name may vary according to the software version release, and you may have other embedded documents from other programs.  I added the case else statement so you can track them down and add them to your code during testing until you finally roll it out on the real thing.

Your final version may include several dozen object names.   But give me a few hours, and perhaps I can create another agent that will poll all the types in the view for you.

0
 
LVL 18

Expert Comment

by:marilyng
ID: 18192120
I probably should have included the revised document name to avoid files being overwritten:

Case Lcase("Microsoft Office Excel Worksheet")                              
        Filename =DetachFolder +  "\ExcelWorksheet" + "_" + doc.NoteID + "_" +  Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".xls"
Case Lcase("Microsoft Word Document")
         Filename =DetachFolder +  "\WordDocument" + "_" +  doc.NoteID + "_" +  Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".doc"
Case Lcase("Microsoft Visio Drawing")
         Filename =DetachFolder +  "\Visio Drawing" + "_" +  doc.NoteID + "_" + Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".vsd"
Case lcase("Excel Worksheet")
          Filename =DetachFolder +  "\ExcelWorksheet" + "_" + doc.NoteID + "_" +  Format(doc.Created, "yyyy-mm-dd") + "_" + Cstr(fileCount +1) + ".xls"

0
 

Author Comment

by:ShyamDalmia
ID: 18337180
Hi SysExpert,

I want to THANK YOU as well for your valuable contribution in resolving this issue for me.

Thanks,
ShyamDalmia
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

VM backups can be lost due to a number of reasons: accidental backup deletion, backup file corruption, disk failure, lost or stolen hardware, malicious attack, or due to some other undesired and unpredicted event. Thus, having more than one copy of …
VM backup deduplication is a method of reducing the amount of storage space needed to save VM backups. In most organizations, VMs contain many duplicate copies of data, such as VMs deployed from the same template, VMs with the same OS, or VMs that h…
To efficiently enable the rotation of USB drives for backups, storage pools need to be created. This way no matter which USB drive is installed, the backups will successfully write without any administrative intervention. Multiple USB devices need t…
This tutorial will show how to configure a new Backup Exec 2012 server and move an existing database to that server with the use of the BEUtility. Install Backup Exec 2012 on the new server and apply all of the latest hotfixes and service packs. The…

707 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

18 Experts available now in Live!

Get 1:1 Help Now