Sub Initialize
Dim ses As New NotesSession
Dim db As NotesDatabase
Dim col As NotesDocumentCollection
Dim doc, docAnexo As NotesDocument
Dim vistaAnexos As NotesView
Dim rtitem As Variant
Dim emb As NotesEmbeddedObject
Dim object As NotesEmbeddedObject
Dim foto As NotesRichTextItem
Set db= ses.CurrentDatabase
Set col= db.UnprocessedDocuments
rutaanterior= ses.GetEnvironmentString( "RutaAnexos" )
If rutaanterior="" Then
rutas="C:\"
Else
rutas=rutaanterior
End If
Dim ruta As String
ruta =Inputbox$ ("Ruta para desanexar los ficheros" ,"Ruta Ficheros" ,rutas )
If Right(ruta,1)= "\" Then
ruta =Left(ruta,Len(ruta)-1)
End If
If Dir$(Ruta,16) ="" Then ' Si no existe la carpeta la creamos
Mkdir ruta
End If
%REM
If Dir$(Ruta+"\*.*",0) <>"" Then ' Si no existe la carpeta la creamos
Messagebox "El directorio " +Ruta +" No debe contener ningún fichero", 64 , "Atención"
Exit Sub
End If
%END REM
Call ses.SetEnvironmentVar( "RutaAnexos", ruta)
Set doc= col.getfirstdocument
For i=1 To col.Count
If doc.HasEmbedded Then
Set rtitem = doc.GetFirstItem( "$FILE" )
If Not rtitem Is Nothing Then
If rtitem.type = Attachment Then
Set emb = doc.GetAttachment(rtitem.values(0))
Print Cstr(i) & " de " &Cstr(col.count) & "Extrayendo --> "& ruta +"\"+emb.Name
Call emb.ExtractFile (ruta +"\"+emb.Name)
End If
End If
End If
Set doc=col.GetNextDocument(doc)
Next
End Sub
|
Otros documentos de LOTUSSCRIPT
|