[syntax="LotusScript"]Option Public
Option Declare
Dim Session As NotesSession
Const Structure_Log = {Script Library : agtExportDesign}
Sub Initialize()
On Error GoTo CatchError
Call ExportDesignNameToExcel(Nothing)
Exit Sub
CatchError:
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 !"
Exit Sub
End Sub
Sub Terminate()
End Sub
Sub ExportDesignNameToExcel(wDB As NotesDatabase)
Dim DBCible As NotesDatabase
Dim objXLSApp As Variant
Dim objXLSWorkbooK As Variant
Dim objXLSWorkSheet As Variant
Dim objXLSRange As Variant
Dim nbLigneXLS As Long
Dim nbLigne1XLS As Long
Dim nbColonneXLS As Long
Dim OngletXLS As String
Dim tbReplaceOnglet (0 To
As String
Dim vrValue As Variant
Dim vrValue2 As Variant
Dim vrValue3 As Variant
Dim Texte As String
Dim Texte2 As String
Dim ACL As NotesACL
Dim form As NotesForm
Dim vwView As NotesView
Dim Agent As NotesAgent
Dim NCollection As NotesNoteCollection
Dim NotesID As String
Dim Doc As NotesDocument
Dim item As NotesItem
Const nbPositionColonneXLS = 1
Const nbFirstLigneXLS = 2
Const nbFirstLigneSortXLS = 3
On Error GoTo CatchError
If Session Is Nothing Then
Set Session = New NotesSession
End If
If wDB Is Nothing Then
Set DBCible = Session.CurrentDatabase
Else
Set DBCible = wDB
End If
REM On récupère une instance Excel ouverte.
Set objXLSApp = Nothing
Set objXLSApp=createobject("Excel.Application")
objXLSApp.DisplayAlerts=False
objXLSApp.Visible=True
objXLSApp.StatusBar = "Creating WorkSheet. Please be patient..."
REM On instancit un objet WorkBook Excel et on ouvre le fichier de mise a jour.
Set objXLSWorkbooK=objXLSApp.Workbooks.add
REM On supprime les éventuelles feuilles en trop !
While objXLSWorkbooK.sheets.count>1
objXLSWorkbooK.sheets(2).select
objXLSWorkbooK.sheets(2).Delete
Wend
OngletXLS = UCase(Trim(DBCible.Title))+" - Export Design, "+Format(Now,"DD-MM-YYYY HH-NN-SS")
If Len(OngletXLS) > 31 Then
OngletXLS = UCase(Trim(DBCible.Title))+" - Export Design, "+Format(Now,"DD-MM-YYYY")
If Len(OngletXLS) > 31 Then
OngletXLS = UCase(Trim(DBCible.Title))+" - Export Design"
If Len(OngletXLS) > 31 Then
OngletXLS = "Export Design"
End If
End If
End If
tbReplaceOnglet (0) = "/"
tbReplaceOnglet (1) = "\"
tbReplaceOnglet (2) = "?"
tbReplaceOnglet (3) = "*"
tbReplaceOnglet (4) = "["
tbReplaceOnglet (5) = "]"
tbReplaceOnglet (6) = "{"
tbReplaceOnglet (7) = "}"
tbReplaceOnglet (8) = ":"
REM elimination des caratères interdit dans l'onglet de la feuille excel
OngletXLS = Replace(OngletXLS,tbReplaceOnglet,"")
Erase tbReplaceOnglet
REM On renomme la première.
objXLSWorkbooK.sheets(1).select
objXLSWorkbooK.sheets(1).Name=Left(OngletXLS,31)
REM On sélectionne la feuille de calcul qui nous intéresse.
objXLSWorkbooK.Sheets(1).Select
Set objXLSWorkSheet = objXLSApp.selection
objXLSApp.Cells.Select
objXLSApp.Selection.NumberFormat = "@"
objXLSApp.Selection.HorizontalAlignment = -4131
objXLSApp.Rows("1:1").Select
objXLSApp.Selection.Font.Bold = True
objXLSApp.Selection.Font.Underline = True
nbColonneXLS = 0
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "DATABASE INFOS"
nbLigneXLS = nbFirstLigneXLS
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Title : "+DBCible.Title
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Path/File : "+DBCible.Filepath
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Server : "+DBCible.Server
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "ReplicaID : "+CStr(DBCible.Replicaid)
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Date Création : "+CStr(DBCible.Created)
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "ODS : "+CStr(DBCible.Fileformat)
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Design Template Name : "+DBCible.Designtemplatename
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Template Name : "+DBCible.Templatename
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Size (Mo) : "+CStr((DBCible.Size/1024)/1024)
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "% Utilisation : "+CStr(DBCible.Percentused)
nbLigneXLS = nbLigneXLS + 1
If DBCible.Isftindexed = True Then
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Indexed : True"
Select Case DBCible.FTIndexFrequency
Case 1
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Update frequency full-text index : Daily"
Case 2
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Update frequency full-text index : Hourly"
Case 3
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Update frequency full-text index : Immediate"
Case 4
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Update frequency full-text index : scheduled"
End Select
else
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Indexed : False"
End If
nbLigneXLS = nbLigneXLS + 1
If DBCible.Isclusterreplication = True Then
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Cluster replication : Effect"
Else
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "Cluster replication : No Effect"
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "RÔLE(S) ACL"
nbLigneXLS = nbFirstLigneXLS
Set ACL = DBCible.Acl
If Not ACL Is Nothing Then
vrValue = ACL.Roles
If testVariant(vrValue) = True Then
ForAll ValueR In vrValue
If Trim(CStr(ValueR)) <> "" Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(ValueR))
End If
End ForAll
End If
vrValue = Null
Set ACL = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES MASQUES"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Forms
If TestVariant(vrValue) = True Then
ForAll valueF In vrValue
Set form = valueF
If Not Form Is Nothing Then
If Form.Issubform = False then
nbLigneXLS = nbLigneXLS + 1
texte = CStr(form.Name)
If TestVariant(form.Aliases) = True Then
ForAll ValueFA In form.Aliases
If Trim(CStr(ValueFA)) <> "" Then
Texte = Texte +" | "+Trim(CStr(ValueFA))
End If
End ForAll
End If
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
Texte = ""
End if
Set form= Nothing
End If
End ForAll
End If
vrValue = Null
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE LOTUS SCRIPT DES MASQUES"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.SelectForms = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = ExplodeLotusScript(Doc.Getitemvalue("$$FormScript")(0))
If Trim(CStr(vrValue(1))) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Doc.Getitemvalue("$Title")(0)
ForAll value In vrValue
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
nbLigneXLS = nbLigneXLS+1
End if
vrValue = null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES MASQUES ET CHAMPS"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Forms
If TestVariant(vrValue) = True Then
ForAll valueF In vrValue
Set form = valueF
If Not Form Is Nothing Then
If Form.Issubform = False then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = CStr(form.Name)
Texte = ""
nbLigne1XLS = nbLigneXLS + 1
If TestVariant(form.Fields) = True Then
ForAll ValueFF In form.Fields
texte = Trim(CStr(ValueFF))
If texte <> "" Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "- "+texte
Texte = ""
End if
End ForAll
End If
If nbLigneXLS > nbLigne1XLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbLigneXLS = nbLigneXLS + 1
End if
Set form= Nothing
End If
End ForAll
End If
vrValue = Null
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE SOUS-MASQUE FIXES PAR MASQUES"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.SelectForms = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$SubForms")
If Trim(CStr(vrValue(0))) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Doc.Getitemvalue("$Title")(0)
nbLigne1XLS = nbLigneXLS+1
ForAll value In vrValue
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "- "+Trim(CStr(value))
End If
End ForAll
nbLigneXLS = nbLigneXLS+1
End If
If nbLigneXLS > nbLigne1XLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES SOUS-MASQUES"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Forms
If TestVariant(vrValue) = True Then
ForAll valueF In vrValue
Set form = valueF
If Not Form Is Nothing Then
If Form.Issubform = true Then
nbLigneXLS = nbLigneXLS + 1
texte = CStr(form.Name)
If TestVariant(form.Aliases) = True Then
ForAll ValueFA In form.Aliases
If Trim(CStr(ValueFA)) <> "" Then
Texte = Texte +" | "+Trim(CStr(ValueFA))
End If
End ForAll
End If
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
Texte = ""
End If
Set form= Nothing
End If
End ForAll
End If
vrValue = Null
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE LOTUS SCRIPT DES SOUS-MASQUES"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.SelectSubforms = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = ExplodeLotusScript(Doc.Getitemvalue("$$FormScript")(0))
If Trim(CStr(vrValue(1))) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Doc.Getitemvalue("$Title")(0)
ForAll value In vrValue
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
nbLigneXLS = nbLigneXLS+1
End if
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES SOUS-MASQUES ET CHAMPS"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Forms
If TestVariant(vrValue) = True Then
ForAll valueF In vrValue
Set form = valueF
If Not Form Is Nothing Then
If Form.Issubform = true Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = CStr(form.Name)
Texte = ""
nbLigne1XLS = nbLigneXLS + 1
If TestVariant(form.Fields) = True Then
ForAll ValueFF In form.Fields
texte = Trim(CStr(ValueFF))
If texte <> "" Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "- "+texte
Texte = ""
End If
End ForAll
End If
If nbLigneXLS > nbLigne1XLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbLigneXLS = nbLigneXLS + 1
End If
Set form= Nothing
End If
End ForAll
End If
vrValue = Null
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES DOCUMENTS PROFILS"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.SelectProfiles = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
Select Case LCase(Trim(CStr(Doc.Nameofprofile)))
Case "designerdefaults","breakpoints_"
REM on fait rien
Case Else
Texte = Trim(CStr(Doc.Nameofprofile))
If Trim(CStr(Doc.Key)) <> "" Then
Texte = Texte +" ( "+CStr(Doc.Key)+" )"
End If
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End Select
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES PAGES"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectpages = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE LOTUS SCRIPT DES PAGES"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectpages = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = ExplodeLotusScript(Doc.Getitemvalue("$$FormScript")(0))
If Trim(CStr(vrValue(1))) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Doc.Getitemvalue("$Title")(0)
ForAll value In vrValue
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
nbLigneXLS = nbLigneXLS+1
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES VUES"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Views
If TestVariant(vrValue) = True Then
ForAll valueV In vrValue
Set vwView = valueV
If Not vwView Is Nothing Then
If vwView.Isfolder = False then
nbLigneXLS = nbLigneXLS + 1
texte = CStr(vwView.Name)
If TestVariant(vwView.Aliases) = True Then
ForAll ValueVA In vwView.Aliases
If Trim(CStr(ValueVA)) <> "" Then
Texte = Texte +" | "+Trim(CStr(ValueVA))
End If
End ForAll
End If
If vwView.Isprivate = True Then
Texte = Texte +" - Private"
End If
If vwView.Iscalendar= True Then
Texte = Texte +" - Calendar"
End If
If vwView.Isdefaultview = True Then
Texte = Texte +" - Default View"
End If
On Error Resume next
Set Doc = DBCible.Getdocumentbyunid(vwView.Universalid)
On Error GoTo CatchError
If Not Doc Is Nothing Then
Texte2 = Trim(Doc.Getitemvalue("$Flags")(0))
Select Case UCase(texte2)
Case "PY","YW1","Y1W","YW","YDW1","YD1W","YDW"
Texte = Texte +" - Partagé ("+texte2+")"
Case "PYA"
Texte = Texte +" - Partagé, contient documents figurant dans aucun dossier ("+texte2+")"
Case "PYL"
Texte = Texte +" - Partagé, contient documents supprimés ("+texte2+")"
Case "PPY"
Texte = Texte +" - Partagé, devenant Serveur privé à la 1er ouverture ("+texte2+")"
Case "POPY"
Texte = Texte +" - Partagé, devenant Bureau privé à la 1er ouverture ("+texte2+")"
Case "PYV"
Texte = Texte +" - Privé ("+texte2+")"
Case Else
Texte = Texte +" - Type : "+texte2
End Select
texte2 = ""
Set Doc = Nothing
End If
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
Texte = ""
End if
Set vwView= Nothing
End If
End ForAll
End If
vrValue = Null
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE LOTUS SCRIPT DES VUES"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Views
If TestVariant(vrValue) = True Then
ForAll valueV In vrValue
Set vwView = valueV
If Not vwView Is Nothing Then
If vwView.Isfolder = False Then
On Error Resume Next
Set Doc = DBCible.Getdocumentbyunid(vwView.Universalid)
On Error GoTo CatchError
If Not Doc Is Nothing Then
vrValue2 = ExplodeLotusScript(Doc.Getitemvalue("$ViewGlobalScript")(0))
vrValue3 = ExplodeLotusScript(Doc.Getitemvalue("$ViewScript")(0))
If Trim(CStr(vrValue2(1))) <> "" Or Trim(CStr(vrValue3(1))) <> "" Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = CStr(vwView.Name)
End If
If Trim(CStr(vrValue2(1))) <> "" Then
ForAll value In vrValue2
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
End If
If Trim(CStr(vrValue3(1))) <> "" Then
ForAll value In vrValue3
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
End If
If Trim(CStr(vrValue2(1))) <> "" Or Trim(CStr(vrValue3(1))) <> "" Then
nbLigneXLS = nbLigneXLS+1
End if
vrValue3 = Null
vrValue2 = Null
Set Doc = nothing
End If
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
Texte = ""
End If
Set vwView= Nothing
End If
End ForAll
End If
vrValue = Null
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES DOSSIERS"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Views
If TestVariant(vrValue) = True Then
ForAll valueV In vrValue
Set vwView = valueV
If Not vwView Is Nothing Then
If vwView.Isfolder = True Then
nbLigneXLS = nbLigneXLS + 1
texte = CStr(vwView.Name)
If TestVariant(vwView.Aliases) = True Then
ForAll ValueVA In vwView.Aliases
If Trim(CStr(ValueVA)) <> "" Then
Texte = Texte +" | "+Trim(CStr(ValueVA))
End If
End ForAll
End If
If vwView.Isprivate = True Then
Texte = Texte +" - Private"
End If
If vwView.Iscalendar= True Then
Texte = Texte +" - Calendar"
End If
If vwView.Isdefaultview = True Then
Texte = Texte +" - Default View"
End If
On Error Resume Next
Set Doc = DBCible.Getdocumentbyunid(vwView.Universalid)
On Error GoTo CatchError
If Not Doc Is Nothing Then
Texte2 = Trim(Doc.Getitemvalue("$Flags")(0))
Select Case UCase(Texte2)
Case "3PFY"
Texte = Texte +" - Partagé ("+texte2+")"
Case "3PPFY"
Texte = Texte +" - Partagé, devenant Serveur privé à la 1er ouverture ("+texte2+")"
Case "3POPFY"
Texte = Texte +" - Partagé, devenant Bureau privé à la 1er ouverture ("+texte2+")"
Case "3PFYV"
Texte = Texte +" - Privé ("+texte2+")"
Case Else
Texte = Texte +" - Type"+texte2
End Select
Texte2 = ""
Set Doc = Nothing
End If
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
Texte = ""
End If
Set vwView= Nothing
End If
End ForAll
End If
vrValue = Null
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE LOTUS SCRIPT DES DOSSIERS"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Views
If TestVariant(vrValue) = True Then
ForAll valueV In vrValue
Set vwView = valueV
If Not vwView Is Nothing Then
If vwView.Isfolder = True Then
On Error Resume Next
Set Doc = DBCible.Getdocumentbyunid(vwView.Universalid)
On Error GoTo CatchError
If Not Doc Is Nothing Then
vrValue2 = ExplodeLotusScript(Doc.Getitemvalue("$ViewGlobalScript")(0))
vrValue3 = ExplodeLotusScript(Doc.Getitemvalue("$ViewScript")(0))
If Trim(CStr(vrValue2(1))) <> "" Or Trim(CStr(vrValue3(1))) <> "" Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = CStr(vwView.Name)
End If
If Trim(CStr(vrValue2(1))) <> "" Then
ForAll value In vrValue2
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
End If
If Trim(CStr(vrValue3(1))) <> "" Then
ForAll value In vrValue3
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
End If
If Trim(CStr(vrValue2(1))) <> "" Or Trim(CStr(vrValue3(1))) <> "" Then
nbLigneXLS = nbLigneXLS+1
End If
vrValue3 = Null
vrValue2 = Null
Set Doc = Nothing
End If
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
Texte = ""
End If
Set vwView= Nothing
End If
End ForAll
End If
vrValue = Null
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES AGENTS"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Agents
If TestVariant(vrValue) = True Then
ForAll valueA In vrValue
Set Agent = valueA
If Not Agent Is Nothing Then
nbLigneXLS = nbLigneXLS + 1
Texte = CStr(Agent.Name)+" ( "+AssistTriggerLibelle(Agent.Trigger)
If Agent.Trigger = 1 Then
If Agent.IsEnabled = True Then
Texte = Texte+" - Activé -"
Else
Texte = Texte+" - Desactivé -"
End If
End If
Texte = Texte + " )"
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
Texte = ""
Set Agent = Nothing
End If
End ForAll
End If
vrValue = Null
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES AGENCEMENT DE CADRE"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectframesets = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES PLANS"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectoutlines = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES BIBLIOTHEQUES DE JAVA SCRIPT"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectscriptlibraries = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
If Doc.Hasitem("$JavaScriptLibrary") = true Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
End If
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES BIBLIOTHEQUES DE LOTUS SCRIPT"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectscriptlibraries = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
If Doc.Hasitem("$JavaScriptLibrary") = False Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
End If
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DETAILLE DES BIBLIOTHEQUES DE LOTUS SCRIPT"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectscriptlibraries = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
If Doc.Hasitem("$JavaScriptLibrary") = false Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
vrValue = ExplodeLotusScript(Doc.Getitemvalue("$ScriptLib")(0))
nbLigne1XLS = nbLigneXLS+1
ForAll value In vrValue
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
If Left(UCase(Trim(CStr(value))),5) = "- USE" or Left(UCase(Trim(CStr(value))),8) = "- OPTION" Then
nbLigne1XLS = nbLigne1XLS +1
End If
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
vrValue = Null
If nbLigneXLS > nbLigne1XLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbLigne1XLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbLigneXLS = nbLigneXLS + 1
vrValue = Null
End If
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES IMAGES RESSOURCES"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectimageresources = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES RESSOURCES CSS"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectstylesheetresources = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES RESSOURCES JAVA"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectjavaresources = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES CHAMPS PARTAGES"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectsharedfields = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "LISTE DES NAVIGATEURS"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.Selectnavigators = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = Doc.Getitemvalue("$Title")
If TestVariant(vrValue) = True Then
ForAll valueSM In vrvalue
If Trim(CStr(valueSM)) <> "" Then
If Trim(Texte) = "" Then
Texte = Trim(CStr(valueSM))
Else
Texte = Texte + " | " + Trim(CStr(valueSM))
End If
End If
End ForAll
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Texte
texte = ""
End If
vrValue = Null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
If nbLigneXLS > nbFirstLigneSortXLS Then
Set objXLSRange = objXLSWorkSheet.Range(objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS))
objXLSRange.Select
objXLSRange.Sort objXLSWorkSheet.Cells(nbFirstLigneSortXLS,nbColonneXLS), 1, , , , , , 0, 1, False, 1,
Set objXLSRange = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "DATABASE SCRIPTS"
nbLigneXLS = nbFirstLigneXLS
Set NCollection = DBCible.CreateNoteCollection(False)
If Not NCollection Is Nothing Then
Call NCollection.SelectAllFormatElements(False)
NCollection.SelectDatabaseScript = True
Call NCollection.BuildCollection
If NCollection.Count > 0 Then
NotesID = NCollection.Getfirstnoteid()
While Trim(NotesID) <> ""
Set Doc = DBCible.Getdocumentbyid(NotesID)
If Not Doc Is Nothing Then
vrValue = ExplodeLotusScript(Doc.Getitemvalue("$DBScript")(0))
ForAll value In vrValue
If Trim(CStr(value)) <> "" Then
nbLigneXLS = nbLigneXLS+1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(value))
End If
End ForAll
vrValue = null
Set Doc = Nothing
End If
NotesID = NCollection.Getnextnoteid(NotesID)
Wend
Call NCollection.Clearcollection()
End If
Set NCollection = Nothing
End If
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "ACL IMAGE"
nbLigneXLS = nbFirstLigneXLS
vrValue = ACLImage(DBCible)
If TestVariant(vrValue) = True Then
ForAll aclValue In vrValue
If Trim(CStr(aclValue)) <>"" Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(aclValue))
End If
End ForAll
End If
vrValue = Null
%rem
nbColonneXLS = nbColonneXLS +1
nbLigneXLS = nbPositionColonneXLS
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = "ACL ACTIVITY LOG"
nbLigneXLS = nbFirstLigneXLS
vrValue = DBCible.Aclactivitylog
If TestVariant(vrValue) = True Then
ForAll aclValue In vrValue
If Trim(CStr(aclValue)) <>"" Then
nbLigneXLS = nbLigneXLS + 1
objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Trim(CStr(aclValue))
End If
End ForAll
End If
vrValue = Null
%end rem
nbColonneXLS = 0
nbLigneXLS = 0
REM mise en page de la feuille
objXLSApp.Cells.Select
objXLSApp.Selection.NumberFormat = "@"
objXLSApp.Selection.HorizontalAlignment = -4131
objXLSApp.Selection.Font.Name = "Arial"
objXLSApp.Selection.Font.Size = 9
objXLSApp.Selection.Columns.AutoFit
objXLSApp.Selection.EntireRow.AutoFit
objXLSApp.Worksheets(1).Pagesetup.Orientation = 2
objXLSApp.Worksheets(1).PageSetup.centerheader = "&8"+UCase(Trim(DBCible.Title))+" - EXPORT, "+Format(Now,"DD-MM-YYYY HH:NN:SS")
objXLSApp.Worksheets(1).Pagesetup.Rightheader = "&8Page &P / &T"
objXLSApp.Worksheets(1).Pagesetup.CenterFooter = ""
objXLSApp.Worksheets(1).Pagesetup.TopMargin = 30
objXLSApp.Worksheets(1).Pagesetup.LeftMargin = 10
objXLSApp.Worksheets(1).Pagesetup.RightMargin = 10
objXLSApp.Worksheets(1).Pagesetup.BottomMargin = 10
objXLSApp.Worksheets(1).Pagesetup.FooterMargin = 0
objXLSApp.Worksheets(1).Pagesetup.HeaderMargin = 0
objXLSApp.Worksheets(1).Pagesetup.CenterFooter = ""
objXLSApp.Worksheets(1).Pagesetup.CenterHorizontally = True
objXLSApp.ReferenceStyle = 1
objXLSApp.Range("A1").Select
objXLSApp.Visible=True
objXLSApp.StatusBar = "Importing Data from Lotus Notes Application was Completed."
Set objXLSApp=Nothing
Set objXLSWorkbooK= Nothing
Exit Sub
CatchError:
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 !"
Exit Sub
End Sub
Function TestVariant(vrValue As Variant) As Boolean
%rem
'Cette fonction permet de savoir si un variant est renseigné.
'renvois false si la variable est vide, nul ou égale à nothing
'si la variable est une liste ou un tableau renvoi false si il n'y a aucune ligne
%end rem
Dim i As Long
On Error GoTo ErreurHandle
Select Case DataType(vrValue)
Case 0,1,10
REM EMPTY,NULL, OLE error
TestVariant = False
Case 9
REM OLE object or NOTHING
If vrValue Is Nothing Then
TestVariant = False
Else
TestVariant = True
End If
Case Else
If IsEmpty(vrValue) = True Then
TestVariant = False
Exit Function
End If
i = 0
If IsArray(vrValue) Or IsList(vrValue) Then
ForAll Value In vrValue
i = i+1
If i > 2 Then
REM pour eviter un traitement trop long s'il ya bcp de valeurs
Exit ForAll
End If
End ForAll
If i = 0 Then
TestVariant = False
Else
TestVariant = True
End If
Else
TestVariant = True
End If
i = 0
End Select
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 !"
TestVariant = False
End Function
Public Function AssistTriggerLibelle(nbTrigger As Integer) As String
On Error GoTo CatchError
AssistTriggerLibelle = ""
Select Case nbTrigger
Case 1
AssistTriggerLibelle = "Scheduled"
Case 2
AssistTriggerLibelle = "After mail arrives"
Case 3
AssistTriggerLibelle = "When documents are pasted"
Case 4
AssistTriggerLibelle = "Manual"
Case 5
AssistTriggerLibelle = "After documents are created Or modified"
Case 6
AssistTriggerLibelle = "Before New mail arrives"
Case Else
AssistTriggerLibelle = "UNKNOWN"
End Select
Exit Function
CatchError:
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 !"
AssistTriggerLibelle = ""
Exit Function
End Function
Function ACLImage(wDB As NotesDatabase) As Variant
REM renvois une "image" de la lca de la base cible
REM toutes les personnes/groupes avec leur type d'accès et les roles associés
Dim DBCible As NotesDatabase
Dim lstValue List As String
Dim acl As NotesACL
Dim Entry As NotesACLEntry
Dim i As Integer
Dim nmEntry As NotesName
Dim TypeEntry As String
Dim TypeAccess As String
Dim Role As String
Dim Info As String
On Error GoTo CatchError
If Session Is Nothing Then
Set Session = New NotesSession
End If
If wdb Is Nothing Then
Set DBCible = Session.currentdatabase
Else
Set DBCible = wDB
End If
Set acl = DBCible.ACL
If acl Is Nothing Then
Error 9999,"ACL inaccessible sur la base cible"
Exit Function
End If
I = -1
Set Entry = Acl.getfirstEntry
While Not Entry Is Nothing
i = i+1
Set nmEntry = New NotesName(Entry.Name)
Select Case Entry.UserType
Case 0
TypeEntry ="Unspecified"
Case 1
TypeEntry = "Person"
Case 2
TypeEntry = "Server"
Case 3
TypeEntry = "Mixed_Group"
Case 4
TypeEntry ="Person_Group"
Case 5
TypeEntry ="Server_Group"
Case Else
TypeEntry = "Unknown"
End Select
Select Case Entry.Level
Case 0
TypeAccess ="No Access"
Case 1
TypeAccess = "Depositor"
Case 2
TypeAccess = "Reader"
Case 3
TypeAccess = "Author"
Case 4
TypeAccess ="Editor"
Case 5
TypeAccess ="Designer"
Case 6
TypeAccess = "Manager"
Case Else
TypeAccess = "Unknown"
End Select
Role = ""
ForAll Role2 In Entry.roles
If Trim(Role) = "" Then
Role = Trim(CStr(Role2))
Else
Role = Role+"-"+Trim(CStr(Role2))
End If
End ForAll
If Trim(Role)<>"" Then
Role = ", Role(s) : "+Role
End If
Info = ""
If Entry.CanCreateDocuments = True Then
Info = ", CanCreateDocuments"
End If
If Entry.CanDeleteDocuments = True Then
If Trim(Info)="" Then
Info = ", CanDeleteDocuments"
Else
Info = Info + ", CanDeleteDocuments"
End If
End If
If Entry.IsPublicReader = True Then
If Trim(Info)="" Then
Info = ", PublicReader"
Else
Info = Info + ", PublicReader"
End If
End If
If Entry.IsPublicWriter = True Then
If Trim(Info)="" Then
Info = ", PublicWriter"
Else
Info = Info + ", PublicWriter"
End If
End If
lstValue(i) = nmEntry.abbreviated+"("+TypeEntry+") : "+TypeAccess+Role+Info
Role = ""
TypeEntry = ""
TypeAccess = ""
Info = ""
Set nmEntry = Nothing
Set Entry = Acl.getNextEntry(Entry)
Wend
ACLImage = lstValue
Erase lstValue
Set DBCible = Nothing
Set acl = Nothing
Exit Function
CatchError:
Set DBCible = Nothing
Set acl = Nothing
Set nmEntry = Nothing
TypeEntry = ""
TypeAccess = ""
Role = ""
Info = ""
MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Erase lstValue
lstValue(0) = ""
ACLImage = lstValue
Erase lstValue
Exit Function
End Function
Function ExplodeLotusScript(wScript As String) As Variant
Dim lstValue List as String
Dim i As Integer
Dim vrValue As Variant
Dim Texte As string
On Error GoTo CatchError
If Trim(wScript) = "" Then
lstValue(1) = ""
ExplodeLotusScript = lstValue
Erase lstValue
Exit function
End If
i=0
If InStr(LCase(wScript),"option public") > 0 Then
Texte = Texte+" Public"
End If
If InStr(LCase(wScript),"option declare") > 0 Then
Texte = Texte+" Declare"
End If
If InStr(LCase(wScript),"option explicit") > 0 Then
Texte = Texte+" Explicit"
End If
If Trim(Texte) = "" Then
Texte = "Option : NO Option"
Else
Texte = "Option : "+Texte
End If
lstValue(i) = "- "+Texte
Texte = ""
vrValue = Split(wScript,Chr(10))
If testVariant(vrValue) = True Then
ForAll ValueFS In vrvalue
If Left(UCase(Trim(CStr(ValueFS))),Len("USE")) = "USE" Then
i=i + 1
lstValue(i) = "- "+Trim(CStr(ValueFS))
End If
If Left(UCase(Trim(CStr(ValueFS))),Len("DECLARE FUNCTION")) = "DECLARE FUNCTION" Then
Texte = Trim(Replace(StrLeft(CStr(ValueFS),"("),"Declare Function","",,5))
If Trim(Texte) <> "" Then
i=i + 1
lstValue(i) = "- "+Texte +" ( Function )"
End If
Texte = ""
End If
If Left(UCase(Trim(CStr(ValueFS))),Len("DECLARE PUBLIC FUNCTION")) = "DECLARE PUBLIC FUNCTION" Then
Texte = Trim(Replace(StrLeft(CStr(ValueFS),"("),"Declare Public Function","",,5))
If Trim(Texte) <> "" Then
i=i + 1
lstValue(i) = "- "+Texte + " ( Public Function )"
End If
Texte = ""
End If
If Left(UCase(Trim(CStr(ValueFS))),Len("DECLARE PRIVATE FUNCTION")) = "DECLARE PRIVATE FUNCTION" Then
Texte = Trim(Replace(StrLeft(CStr(ValueFS),"("),"Declare Private Function","",,5))
If Trim(Texte) <> "" Then
i=i + 1
lstValue(i) = "- "+Texte + " ( Private Function )"
End If
Texte = ""
End If
If Left(UCase(Trim(CStr(ValueFS))),Len("DECLARE SUB")) = "DECLARE SUB" Then
Texte = Trim(Replace(StrLeft(CStr(ValueFS),"("),"Declare Sub","",,5))
If Trim(StrRight(Texte,"SUB")) <> "INITIALIZE" Then
If Trim(Texte) <> "" Then
i=i + 1
lstValue(i) = "- "+Texte + " ( Sub )"
End If
End If
Texte = ""
End If
If Left(UCase(Trim(CStr(ValueFS))),Len("DECLARE PUBLIC SUB")) = "DECLARE PUBLIC SUB" Then
Texte = Trim(Replace(StrLeft(CStr(ValueFS),"("),"Declare Public Sub","",,5))
If Trim(StrRight(Texte,"SUB")) <> "INITIALIZE" Then
If Trim(Texte) <> "" Then
i=i + 1
lstValue(i) = "- "+Texte+ " ( Public Sub )"
End If
End If
Texte = ""
End If
If Left(UCase(Trim(CStr(ValueFS))),Len("DECLARE PRIVATE SUB")) = "DECLARE PRIVATE SUB" Then
Texte = Trim(Replace(StrLeft(CStr(ValueFS),"("),"Declare Private Sub","",,5))
If Trim(StrRight(Texte,"SUB")) <> "INITIALIZE" Then
If Trim(Texte) <> "" Then
i=i + 1
lstValue(i) = "- "+Texte+ " ( Private Sub )"
End If
End If
Texte = ""
End If
End ForAll
End If
ExplodeLotusScript = lstValue
Erase lstValue
Exit Function
CatchError:
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 !"
lstValue(1) = ""
ExplodeLotusScript = lstValue
Erase lstValue
Exit Function
End Function[/syntax]
