Détacher les fichiers attachés
Publié: 06 Juil 2005 à 16:47d'apres une fonction posté par ex_Stagiaire
- Code : Tout sélectionner
Public Function FileDetach(wDoc As notesdocument, Byval wChamp As String,wDirectory As String,wFileName As String) As String
'Déclaration Variable
Dim rtitem As NotesRichTextItem
On Error Goto ErreurHandle
FileDetach = ""
If wDoc Is Nothing Then
Error 9999,"wDoc is Nothing"
Else
If wDoc.HasEmbedded = False Then
Exit Function
End If
End If
If Trim(wChamp) <> "" Then
Set rtitem = wDoc.GetFirstItem(wChamp)
If rtitem Is Nothing Then
Error 9999,"rtitem => ''"+wChamp+"'' is nothing"
Exit Function
Else
If (rtitem.Type <> RICHTEXT) Then
Error 9999,"'"+wChamp+"'' is not NotesRichTextItem"
Exit Function
End If
End If
End If
If Trim(wDirectory) = "" Then
Error 9999,"wDirectory empty"
Exit Function
Else
If Right(Trim(wDirectory),1)<>"\" Then
wDirectory = Trim(wDirectory)+"\"
Else
wDirectory = Trim(wDirectory)
End If
End If
If Trim(wFileName) = "" Then
Error 9999,"wFileName empty"
Exit Function
End If
If Trim(wChamp) <> "" Then
Forall Attachement In rtitem.EmbeddedObjects
Select Case Attachement.Type
Case 1454, EMBED_ATTACHMENT
If Trim(Attachement.Name) = Trim(wFileName)Then
Call Attachement.ExtractFile(wDirectory+Attachement.Name)
FileDetach = Attachement.Name
Set rtitem = Nothing
Exit Function
End If
Case 1453,EMBED_OBJECT
Case 1452, EMBED_OBJECTLINK
End Select
End Forall
End If
Forall Attachement In wDoc.EmbeddedObjects
Select Case Attachement.Type
Case 1454, EMBED_ATTACHMENT
If Trim(Attachement.Name) = Trim(wFileName)Then
Call Attachement.ExtractFile(wDirectory+Attachement.Name)
FileDetach = Attachement.Name
Set rtitem = Nothing
Exit Function
End If
Case 1453,EMBED_OBJECT
Case 1452, EMBED_OBJECTLINK
End Select
End Forall
Set rtitem = Nothing
Exit Function
ErreurHandle:
Msgbox "("+Structure_Log+" : "+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 !" Set rtitem = Nothing
FileDetach = ""
Exit Function
End Function