Comment exporter dans un chiffrier l’arborescence des dossiers/sous dossiers du référentiel?

Ces quelques lignes de code en Visual Basic permettent d’exporter l’arborescence des dossiers/sous dossiers de votre référentiel dans un chiffrier Excel.

Compatible avec PowerDesigner/PowerAMC 16.5

 '* Nom du fichier : ARBORESCENCE.vbs 
 '* Définition : Export de l'arborescence des dossiers/sous dossiers de votre référentiel dans un chiffrier
 '* Objets: Dossier, Référentiel
 '* Auteur: Benoît Le Nabec 
 '* URL : http://www.Powerd911.guru
 '* Créé: 2015-01-01 
 '* Version: 1.0 
 '***********************************************************************

Option Explicit  

' Lancement de l'application Excel
Dim objExcel
Dim objWorkbook

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible=True

Set objWorkbook = objExcel.Workbooks.Add

' Vérification si nous avons une connexion active au référentiel
Dim repository, connected

Set repository = RepositoryConnection

connected = repository.Connected

If not connected then
   connected = repository.Open()
End If

Dim intRow ' Numéro de l'enregistrement courant

intRow=1

If connected then
   ' On conserve le nom du référentiel sur la première ligne du chiffrier
   objExcel.Cells(intRow, 1)=repository.name

   ' On incrémente le numéro de l'enregistrement
   intRow=intRow+1

   ' On inscrit l'arborescence du référentiel dans le chiffrier Excel
   ScanRepository repository, repository.name, objExcel, intRow

   ' Rafraichissement de la fênêtre du référentiel de PowerAMC
   repository.Refresh

   ' On sauve le résultat dans le fichier 
   objWorkbook.SaveAs("C:\temp\Liste_Dossiers_Référéntiel.xls")

   ' On quitte le chiffrier Excel
   objExcel.Quit
Else
   ' Message d'avertissement
   MsgBox "Une connexion au référentiel est nécessaire!"
End If


' Procédure récursive qui permet de réaliser une lecture des dossiers du référentiel
Sub ScanRepository (folder, name, objExcel, intRow)
Dim subObject
Dim Subfoldername

' Avons-nous une connexion au référentiel?
If folder is Nothing then
   Exit Sub
End If

' Lecture de chacun des dossiers du référentiel
For Each subObject in folder.ChildObjects

   ' Si l'nbjet est un dossier
   If subObject.IsKindOf(PdRMG.Cls_RepositoryFolder) then
   
      ' On conserve le nom du dossier
      subfoldername=Name & "\" & subObject.name
      objExcel.Cells(intRow,1)=subfoldername

      ' On incrémente le numéro d'enregistrement
      intRow=intRow + 1

      ' On vérifie s'il y a des sous-dossiers
      ScanRepository subObject, subfoldername, objExcel, intRow
   End If
Next

End Sub