Edit : le code n'est pas stable voici un lien vers une version stable => http://www.nsftools.com/tips/NotesTips.htm#rtfexport
- Code : Tout sélectionner
Public Function ExportRTtoRTF_API(wDoc As NotesDocument, wChamp As String, wPathTemp As String, wPathCible As String, wFileNameCible As String) As Integer
'wDoc : document à traiter
'wChamp : champ richtext a traiter
'wPathTemp : chemin du repertoire temporaire ou de travail
'wPathcible : chemin du répertoire ou sera créé le fichier
'wFileNameCible : nom du fichier a créer
%REM
'variableAPI pour la fonction ExportRTtoRTF_API
Declare Function ExportRTF Lib "nxrtf" Alias "ExportRTF" (Byval sTempFile As String, Byval flags As Long, hmod As Long, Byval altlibrary As String, Byval sRTFFile As String) As Integer
Declare Function MailGetMessageBodyComposite Lib "nnotes.dll"(Byval hNote As Long, Byval ItemName As String,Byval FileName As String, FileSize As Long)As Integer
%END REM
'déclaration Variable
Dim fileSize As Long
Dim PathFile As String
Dim file_name As String
Dim font_file As String
On Error Goto ErreurHandle
ExportRTtoRTF_API = False
If wDoc Is Nothing Then
Error 9999,"wDoc is nothing"
Exit Function
End If
If Trim(wChamp) = "" Then
Error 9999,"wChamp is empty"
Exit Function
Elseif wDoc.HasItem(Trim(wChamp)) = False Then
Error 9999,"Field not found : "+wChamp
Exit Function
Elseif wDoc.GetFirstItem(Trim(wChamp)).type <> 1 Then
Error 9999,"not a richtext field : "+wChamp
Exit Function
End If
If Trim(wPathTemp) = "" Then
Error 9999,"wPathTemp is Empty"
Exit Function
End If
If Trim(wFileNameCible) = "" Then
Error 9999,"wFileNameCible is Empty"
Exit Function
Elseif Ucase(Right(Trim(wFileNameCible),3)) <> "RTF" Then
Error 9999,"not a RTF File : "+wFileNameCible
Exit Function
End If
If Trim(wPathCible) = "" Then
PathFile = wPathTemp
End If
If Right(Trim(PathFile),1)<>"\" Then
PathFile = Trim(PathFile)+"\"+Trim(wFileNameCible)
Else
PathFile = Trim(PathFile)+Trim(wFileNameCible)
End If
If Right(Trim(wPathTemp),1)<>"\" Then
file_name = Trim(wPathTemp)+"\text.cd"
font_file = Trim(wPathTemp)+"\fonts.cd"
Else
file_name = Trim(wPathTemp)+"text.cd"
font_file = Trim(wPathTemp)+"fonts.cd"
End If
Call MailGetMessageBodyComposite(wDoc.handle , Trim(wChamp), FILE_NAME, fileSize)
Call MailGetMessageBodyComposite(wDoc.handle , "$Fonts", font_file, fileSize)
Call ExportRTF(file_name, 0, 0, "", PathFile )
Kill file_name
Kill font_file
ExportRTtoRTF_API = True
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
ExportRTtoRTF_API = False
Exit Function
End Function
