Avant de tirer ma révérence de développeur lotus notes, voilà une dernière astuce pour détacher les images visibles dans un RT. Ce code est adapté d'un code trouvé sur le web.
A bientôt !
- Code : Tout sélectionner
'/**
' * Permet d'extraire du document des images "collées" dans un RT
' * @param NotesDocument, le document à traiter
' * @return integer
' */
Function ExportImgs(pDoc As NotesDocument) As Integer
On Error GoTo HandleError
ExportImgs = False
Dim se As New NotesSession()
Dim db As NotesDatabase
Dim doc2 As NotesDocument
Dim f As Integer, i As Integer
Dim stream As NotesStream
Dim mimeEntity As NotesMIMEEntity
Dim mimeHeader As NotesMIMEHeader
Dim img(1 To 3, 1 To 3) As String
Dim exporter As NotesDXLExporter
Dim dxl As String, dxlPicture As String, dxlPictureType As String, key As String
Dim destinationPath As String, filename As String, directory As String
Dim counter As Integer
Dim p1 As Long, p2 As Long
Set exporter = se.CreateDXLExporter()
Set db = se.CurrentDatabase()
exporter.ConvertNotesBitmapsToGIF = True
REM GIFs
img(1,1)="<gif>"
img(1,2)="</gif>"
img(1,3)="gif"
REM gif
img(2,1)="<gif originalformat='notesbitmap'>"
img(2,2)="</gif>"
img(2,3)="gif"
REM JPEGs
img(3,1)="<jpeg>"
img(3,2)="</jpeg>"
img(3,3)="jpg"
REM Init du compteur
counter = 0
REM Folder to extract (c:\etc...)
destinationPath = "c:\"
REM Convert document into DXL
dxl = exporter.Export(pDoc)
dxl = Replace(dxl, Chr(13), "")
dxl = Replace(dxl, Chr(10), "")
REM Extract picture data from DXL and write it into tempfile
For i = 1 To 3
key = img(i, 1)
p1 = InStr(p1 + 10, dxl, key , 5)
While p1 > 0
If p1 > 0 Then
p2 = InStr(p1, dxl, img(i, 2), 5)
If p2 > 0 Then
dxlPictureType = img(i, 3)
dxlPicture = Mid(dxl, p1+Len(key), p2-p1-Len(key))
REM Save DXL into tempfile
f = FreeFile
Open destinationPath & "Base64.tmp" For Output As f
Print #f, DXLPicture
Close f
REM Create a new Notes Document with embedded picture
se.ConvertMIME = False
Set Doc2 = New NotesDocument(db)
Set MIMEEntity = doc2.CreateMIMEEntity
Set stream = se.CreateStream
If Not stream.Open(destinationPath & "Base64.tmp", "binary") Then GoTo skip
If stream.Bytes = 0 Then GoTo skip
Call MimeEntity.SetContentFromBytes(stream, "image/gif", ENC_BASE64)
Call stream.Close()
REM Save embedded picture to file
Set stream = se.CreateStream()
filename = pDoc.NoteID & "_" & counter & "." & dxlPictureType
directory = destinationPath & filename
REM Don't remove Resume Next
On Error Resume Next
Kill directory
If Not stream.Open(directory, "binary") Then GoTo skip
Set MIMEEntity = doc2.GetMIMEEntity
Call MimeEntity.GetContentAsBytes(stream)
Call stream.Close()
counter = counter + 1
End If
End If
p1 = InStr(p2 + 1, dxl, key , 5)
Wend
Next i
skip:
se.ConvertMIME = True
If Dir(destinationPath & "Base64.tmp", 0) <> "" Then
Kill destinationPath & "Base64.tmp"
Call stream.Close()
End If
ExportImgs = True
Exit Function
HandleError:
se.ConvertMIME = True
If Dir(destinationPath & "Base64.tmp", 0) <> "" Then
Kill destinationPath & "Base64.tmp"
Call stream.Close()
End If
End Function