Convert image file Attachment into a image resource

The following functions will help you convert image files attached in documents into image resources in the same database. Probable you may have to remove fragments that you dont want to use.

'**************************************************************
'@Purpose     :      To process file attachments and
'                        convert the same into image resources in the current database
'**************************************************************
Private Function ProcessAttachments(imageName As String,flag As String,imagePath As String) As Boolean
   
    'mark the flow of control getting inside the current function
    ProcessAttachments=False
   
    'declare variables and objects necessary for further manipulations
    Dim session As New notessession
    Dim tempFolderPath As String
    Dim directory As String
    Dim db As NotesDatabase
    Dim tempDoc As NotesDocument
    Dim entity As NotesMimeEntity
    Dim imageSize As Long
   
    'handle errors in case of abrupt termination
    On Error Goto processAttErrHandler
   
   
    'set the handle of the current database
    Set db = session.CurrentDatabase
    directory = tempFolderPath
   
    'create a temporary document to contain the mime entity of the images
    Set tempDoc = db.CreateDocument
    If Not( CreateMIMEEntity(imagePath, tempDoc, entity, imageSize)) Then
        Exit Function
    End If
   
    'create a dxl file of the created mime type
    If Not  CreateDXLFile( imagePath, entity, imageSize) Then
        Exit Function
    End If
   
    'import the created dxl file as image resource
    If Not  ImportDXLFile( imagePath, db) Then
        Exit Function
    End If
    'destroy the file created in the temporary folder
    Kill imagePath

    'mark the flow of control getting out of the current function
    ProcessAttachments=True
    Exit Function
    'log the errors that resulted in abrupt termination
processAttErrHandler:
    Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***"   _
    & Cstr(Err) & "*** in Method ""ProcessAttachments"" in script Library ""lsLookAndFeel"""
  
    Exit Function
End Function   

'****************************************************************
'@Created      :      2008/09/12
'@Purpose     :      To create a dxl file that resembles the dxl of design elements in Image resources
'                        provided the mime type of an image file   
'****************************************************************
Private Function CreateDXLFile( imagePath As String, entity As NotesMimeEntity, imageSize As Long)
   
    'mark the flow of control getting inside the current function
    CreateDXLFile=False
   
    'declare all variables and objects necessary for furhter manipulation
    Dim session As New notessession
    Dim stream As NotesStream
    Dim directory As String
    Dim imageName As String
   
    'initiation
    'handle errors in case of abrupt termination
    On Error Goto errHandler
   
    If Instr(imagePath, "\") <> 0 Then
        directory = Strleftback(imagePath, "\") & "\"
        imageName = Strrightback(imagePath, "\")
    Else
        directory = Strleftback(imagePath, "/") & "/"
        imageName = Strrightback(imagePath, "/")
    End If
   
    'create a stream
    Set stream = session.CreateStream
    If Not stream.Open(directory & Strleftback(imageName, ".") & ".dxl", "ISO-8859-1") Then
        Error 1405, "Cannot create file " & directory & Strleftback(imageName, ".") & ".dxl on the server."
    End If
    Call stream.WriteText({})
   
    Call stream.WriteText({
    Call stream.WriteText({ noreplace='true' publicaccess='false' designerversion='7'>})
    If Right(Lcase(imageName), 4) = ".gif" Then
        Call stream.WriteText({})
        Call stream.WriteText(entity.ContentAsText)
        Call stream.WriteText({})
    Else
        Call stream.WriteText({})
        Call stream.WriteText(entity.ContentAsText)
        Call stream.WriteText({})
    End If
    Call stream.WriteText({})
    Call stream.WriteText(Cstr(imageSize) & {})
    Call stream.WriteText({})
    If Right(Lcase(imageName), 4) = ".gif" Then
        Call stream.WriteText({image/gif})
    Else
        Call stream.WriteText({image/jpeg})
    End If
    Call stream.WriteText({})
    Call stream.WriteText({})
    Call stream.WriteText(Format$(Now, "YYYYMMDD") & "T" & Format$(Now, "HHMMSS") & ",00-00")
    Call stream.WriteText({})
    Call stream.WriteText({})
    Call stream.Close

    'mark the flow of control movingout of the current function
    CreateDXLFile=True
   
    Exit Function
    'log the error that resulted in abrupt termination
errHandler:
    Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***"   _
    & Cstr(Err) & "*** in Method ""CreateDXLFile"" in script Library ""lsLookAndFeel"""

    Exit Function
End Function

'****************************************************************
'@Created      :      2008/09/12
'@Purpose     :      To create mime content of an image file
'****************************************************************
Function  CreateMIMEEntity( imagePath As String, tempDoc As  NotesDocument, entity As  NotesMimeEntity, imageSize As Long)As Boolean
   
    'mark the flow of control getting inside the current function
    CreateMIMEEntity=False
   
    'declare variables and objects necessary for further manipulation
    Dim session As New notessession
    Dim stream As NotesStream
   
    'initiation
    'handler errors in case of abrupt termination
    On Error Goto mimeErrHandler
   
    'create a stream object
    Set stream = session.CreateStream
    If Not stream.Open(imagePath) Then
        Error 1404, "Cannot open file " & imagePath & " for processing."
        Exit Function
    End If
   
    imageSize = stream.Bytes
   
    Call tempDoc.ReplaceItemValue("Form", "Temporary Document")
    Set entity = tempDoc.CreateMIMEEntity
    If Right(Lcase(imagePath), 4) = ".gif" Then
        Call entity.SetContentFromBytes(stream, "image/gif", ENC_NONE)
    Else
        Call entity.SetContentFromBytes(stream, "image/jpeg", ENC_NONE)
    End If
    Call entity.EncodeContent(ENC_BASE64)
    Call stream.Close
    'mark the flow of control moving out of the current function
    CreateMIMEEntity=True
    Exit Function
mimeErrHandler:
    Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***"   _
    & Cstr(Err) & "*** in Method ""CreateMIMEEntity"" in script Library ""lsLookAndFeel"""   
    Exit Function
End Function

'****************************************************************
'@Created      :      2008/09/12
'@Purpose     :      To import a dxl file in to the current database
'****************************************************************
Private Function ImportDXLFile( imagePath As String, db As NotesDatabase) As Boolean
   
    'mark the flow of control getting inside the current function
    ImportDXLFile=False
   
    'declaring variables and objects necessary for further manipulation
    Dim session As New notessession
    Dim stream As NotesStream
    Dim importer As NotesDXLImporter
    Dim dxlPath As String
   
    'initiation
    'handle errors in case of abrupt termination
    On Error Goto errHandler
   
    dxlPath = Strleftback(imagePath, ".") & ".dxl"
   
    Set stream = session.CreateStream
    If Not stream.Open(dxlPath, "ISO-8859-1") Then
        Error 1406, "Cannot open file " & dxlPath & " after it was created."
    End If
   
    Set importer = session.CreateDXLImporter(stream, db)
    importer.ReplaceDBProperties = False
    importer.ReplicaRequiredForReplaceOrUpdate = False
    importer.DesignImportOption = DXLIMPORTOPTION_REPLACE_ELSE_CREATE
    Call importer.Process
    Call stream.Close

    'mark the flow of control movingout of the current function
    ImportDXLFile=True
   
    Exit Function
    'log the errors that resulted in abrupt termination
errHandler:
    Print "Error ***" & Error & "*** occured on line ***" & Cstr(Erl) & "*** with error number ***"   _
    & Cstr(Err) & "*** in Method ""ImportDXLFile"" in script Library ""lsLookAndFeel"""


    Exit Function
End Function