The objects stored in the NOTES are exported into one file.
Sub Click (Source As Button)
ON Error Goto Isoerr
DIM W AS New NotesuiWorkSpace
DIM S as New Notessession
DIM Isolog As New Noteslog ("Writeiso")
Dim dbcur as notesdatabase
DIM DCLCUR AS NotesDocumentCollection
DIM DOCCUR As NotSdocument
DIM OLE AS NOTESEMBEDDEDOBJECT
Dim att as variant
Dim Dbnew as notesdatabase
Call isolog.openfilelog ("D: /ISOLOG.TXT")
'Isolog.OverWritefile = TRUE
isolog.logAction ("=========================== Current time is:" now () "======= ================================ ")
SET DBCUR = S.CurrentDatabase
Set dbnew = s.getdatabase ("CN = zhbpms / o = gdtel", "zhteloa / isofilemanager.nsf", false)
% REM
Dim dociso as notesdocument
DIM DOCF as Notesdocument
SET DOCISO = DBNEW.CREATEDOCUMENT
SET DOCF = DBNEW.GETDOCUMENTBYUNID ("9D7EE71D70644E7048256F3800345178")
Dociso.form = "f_deptfile"
Dociso.parentdocunid = "9D7EE71D70644E7048256F3800345178"
Dociso.str_type = "file"
Dociso.foldername = "Export Action"
Dociso.str_orgtype = "org"
Dociso.docid = Dociso.universalid
Dociso.delsymbol = "0"
Dociso.dbpath = "zhteloa / isofilemanager.nsf"
If Dociso.save (True, False) THEN
Call dociso.makeresponse (docf)
Call dociso.save (True, False)
Else
Isolog.LogAction ("a")
END IF
% Endrem
Set dclcur = dbcur.unprocessedDocuments
IF dclcur.count> 0 THEN
SET DOCCUR = dclcur.getfirstdocumentWhile Not Doccur Is Nothing
Data from the old ISO
If Doccur.hasembedded Then
DIM APP
DIM Document
DIM RTITEM AS NotesrichTextItem
DIM Embedded As NotSembeddedObject
Set RTITEM = DOCCUR.GETFIRSTITEM ("Body")
Set Embedded = RTITEM.EMBEDDEDOBJECTS (0)
Call Embedded.ActiVate (True)
Set app = Embedded.Object
'Handling Excel
If doccur. ~ $ OleobjProgid (0) = "Excel.sheet" THEN
Call app.saves ("d: /" doccur.Universalid ". Xls")
'Set wks = app.Application.worksheets (1)
'Call Wks.saveas ("D: /" Doccur.Universalid ". Xls")
'App.application.activedocument.saveas ("d: //" doccur.Universalid ".xls")
END IF
'Handling PPT
IF doccur. ~ $ OleobjProgid (0) = "PowerPoint.show" THEN
Call app.saves ("D: /" Doccur.Universalid ". PPT")
END IF
'Handling Word
IF doccur. ~ $ OleobjProgid (0) = "word.document" Then
Call app.saveas ("D: /" Doccur.Universalid ". Doc")
'Set document = app.application.documents (1)
'Call Document.saves ("D: //" Doccur.Universalid ".doc")
END IF
END IF
'Put the detached data in the new OA library
Dim dociso as notesdocument
DIM RTF as NotesrichTextItem
DIM DOCF as Notesdocument
DIM VWORG AS NotesView
DIM DCLSEC AS NotesDocumentCollection
SET DOCISO = DBNEW.CREATEDOCUMENT
Set vWorg = DBNEW.GETVIEW ("vwrootf")
'Find one level folder
IF doccur.largekind (0) <> "" "
'Dim Key As String
'If doccur.largekind (0) = "Quality record table list" or doccur.largekind (0) = "Quality record table list" THEN
'Key = "Quality Records and List"
'Else
'Key = DOCCUR.LARGEKIND (0)' end if
SET DOCF = vWorg.getDocumentByKey (DOCCUR.LARGEKIND (0))
IF docf is nothing then
Isolog.LogAction ("No" in New OA " DOCCUR.LARGEKIND (0) " "This level classification!")
Goto NextProdoc
END IF
END IF
'Find a secondary folder
If Doccur.Secondkind (0) <> "" "
Set dclsec = docf.responses
DIM DOCTMP As NotSdocument
Dim Hassec as boolean
Hassec = false
IF dclsec.count> 0 THEN
For i = 1 to dclsec.count
Set doctMP = dclsec.getnthdocument (i)
If DOCTMP.FOLDERNAME (0) = DOCCUR. Secondkind (0) THEN
SET DOCF = DOCTMP
Hassec = TRUE
END IF
NEXT
END IF
IF (not Hassec) or dclsec.count = 0 THEN
Isolog.LogAction ("No" in New OA " Doccur.Secondkind (0) " This secondary classification! ")
Goto NextProdoc
END IF
END IF
Dociso.form = "f_deptfile"
Dociso.parentdocunid = docf.Universalid
Dociso.str_type = "file"
Dociso.foldername = DOCCUR.SUBJECT (0)
Dociso.str_orgtype = "org"
Dociso.docid = Dociso.universalid
Dociso.delsymbol = "0"
Dociso.dbpath = "zhteloa / isofilemanager.nsf"
Dociso.hidden = "0"
Dociso.isarchiveSattach = ""
'Set the text information
Dociso.haswordDoc = "1"
ISUseupTemplate = "0"
Ofilename = DOCCUR.Universalid ". Doc"
Ofiledate = ""
Dim srcfilename as string
SET RTF = Dociso.createrichTextItem ("LastversionDoc")
If Dociso.save (True, False) THEN
If doccur. ~ $ OleobjProgid (0) = "Excel.sheet" THEN
Srcfilename = doccur.Universalid ". xls"
'Set wks = app.Application.worksheets (1)
'Call Wks.saveas ("D: /" Doccur.Universalid ". Xls")
'App.application.activedocument.saves ("d: //" doccur.Universalid ".xls") endiff
'Handling PPT
IF doccur. ~ $ OleobjProgid (0) = "PowerPoint.show" THEN
Srcfilename = doccur.Universalid ". PPT"
END IF
'Handling Word
IF doccur. ~ $ OleobjProgid (0) = "word.document" Then
SrcFileName = DOCCUR.UNIVERSALID ". DOC"
'Set document = app.application.documents (1)
'Call Document.saves ("D: //" Doccur.Universalid ".doc")
END IF
Call RTF.EMBEDObject (Embed_attachment, "", "D: //" srcFileName, SrcFileName)
Call dociso.makeresponse (docf)
Call dociso.save (True, False)
Else
Isolog.LogAction ("a")
END IF
NextProdoc:
SET DOCCUR = dclcur.getNextDocument (DOCCUR)
Wend
END IF
isolog.logAction ("=========================== Current time is:" now () "======= ================================ ")
Call isolog.close
EXIT SUB
Isoerr:
Print "No. CSTR (ERL ()) " Line, Appears " Error () " Error "
Isolog.LogAction (CSTR (ERL ()) " Error ())
Call isolog.close
End Sub
