« Le 1er février 2007... | Main| Backup Lotus Script »

Classes OLE

0

Travailler avec les classes OLE
Certaines fonctionnalités Lotus Script sont assez limitées dès lors qu'il s'agit de sortir du modèle d'objets Domino. Il existe plusieurs alternitatives de programmation à ces limitations. Une de ces alternatives consiste à utiliser les classes OLE Lotus Script...

...
Le code de l'exemple ci dessous permet :
  • de répertorier l'ensemble des fichiers à partir d'un répertoire source (incluant les sous-répertoires)
  • d'écrire la liste des fichiers trouvés dans un fichier texte de sortie.

Il est possible de réaliser quelque chose de similaire en fonctions LotusScript, mais les performances ne sont pas au rendez-vous.
Il serait également possible, depuis  une ligne de code LotusScript, de générer le fichier de sortie à partir d'un shell dir, mais on perd le contrôle de l'exécution dès que la commande est envoyée au niveau du système.

Alors pourquoi pas à l'aide de classes OLE ?
Les deux classes utilisées dans cet exemples sont Scripting.FileSystemObject et WScript.Shell.

Les propriétés et méthode de la classe Scripting.FileSystemObject permettent de manipuler des fichiers, des réperoires (existence d'un fichier, copie, création de répertoires...)

Les propriétés et méthode de la classe WScript.Shell permettent de s'attaquer aux fonctions du système, pour par exemple afficher des boites de dialogues.

Déclarations :
Dim ShellO
Dim FSO
Dim objShell
Dim Folder
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0

Evénement d'initialisation :
Sub Initialize
        Set ShellO = CreateObject("WScript.Shell")
        Set FSO = CreateObject("Scripting.FileSystemObject")
End Sub


Fonction de sélection d'un dossier :
Function choixDossier() As String
        Set objShell = CreateObject("Shell.Application")
        Set Folder = objShell.BrowseForFolder _
        (WINDOW_HANDLE, "Choisissez un répertoire à analyser :", NO_OPTIONS)
        Set objFolderItem = Folder.Self
        choixDossier = objFolderItem.path
End Function

La fonction suivante recense les sous-répertoires du répertoire choisi, puis écrit le résultat dans un fichier texte :
Function recense() As Variant
        Dim Liste, chemin,DossiersIN, DossierRacine, Fichier
        chemin = choixDossier 'la fonction de sélection de dossier
        'Si le chemin est valide
        If chemin <> "" Then
    'chemin Bureau de windows + "\"
                Liste = ShellO.SpecialFolders("Desktop")
                If Right(Liste, 1) <> "\" Then Liste = Liste & "\"                
   'Création et ouverture du fichier contenant l'arborescence du répertoire à traiter
                Set Fichier = FSO.CreateTextFile(Liste & "Liste.txt", 1, True)
                Set dossierRacine = FSO.GetFolder(chemin)
                Set dossiersIN= dossierRacine.SubFolders        'la collection des sous-répertoires                
   'Écriture de la premiere ligne de la liste
                Fichier.WriteLine ("Contenu du répertoire " & chemin )
                Fichier.WriteLine
                'on parcours la racine
                Fichier.writeLine dossierRacine.path &  " | " & Cstr(dossierRacine.DateLastModified)&" | " & Cstr(Round(dossierRacine.Size / 1024,2))& " KO"                 Forall Fol In dossiersIN
                        Fichier.WriteLine Fol.path &  " | " & Cstr(Fol.DateLastModified)&" | " & Cstr(Round(Fol.Size / 1024,2))& " KO"                
                End Forall                        
        End If
                  Fichier.Close                
                Set ShellO = Nothing
                Set FSO = Nothing
                Set Fichier = Nothing
End Function

On pourrait de la même façon parcourir les fichiers d'un répertoire :  set fichiers = DossierRacine.files
puis une boucle forall f in fichiers

Comments

Gravatar Image2 - Function SHFileOperation_Copy2 (txtSource As String, txtDestination As String) As Integer
' Destination = PROFILPATH + "\"
' Source = UNC_ + "\*.*"
Dim Source As Variant
Dim Destination As Variant
Source=txtSource
Destination=txtDestination
On Error Goto ProcessError
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(Source) Then
If Not (fso.FolderExists(Destination)) Then Set objFolder = fso.CreateFolder(Destination)
Print "Copie " & txtSource & " dans " & txtDestination
' fso.CopyFolder Source, Destination, OverWriteFiles
fso.CopyFolder Source, Destination, True

%REM
CopyFolder
Lorsque source comporte des caractères génériques ou lorsque destination se termine par un séparateur de chemin (), destination est supposé être un dossier existant dans lequel les dossiers et sous-dossiers correspondants seront copiés. Sinon, destination est considéré comme le nom d'un dossier à créer. Dans tous les cas, quatre événements peuvent se produire lors de la copie d'un dossier individuel.
Si destination n'existe pas, le dossier source est copié avec tout son contenu. C'est le cas le plus fréquent.
Si destination est un fichier existant, une erreur se produit.
Si destination est un répertoire, une tentative de copie du dossier et de tout son contenu sera faite. Si un fichier contenu dans source existe déjà dans destination, une erreur se produit lorsque la valeur de overwrite est False. Sinon, une tentative de copie du fichier par écrasement du fichier existant sera faite.
Si destination est un répertoire en lecture seule, une erreur se produit lorsqu'une tentative de copie d'un fichier existant en lecture seule sera faite alors que la valeur de overwrite est False.
Une erreur se produit également lorsqu'un élément source comportant des caractères génériques ne correspond à aucun dossier.
La méthode CopyFolder s'arrête dès qu'elle rencontre une erreur. Aucune tentative n'est faite en vue de restaurer les changements effectués avant que l'erreur se produise.
%END REM
Else
Goto ProcessError
End If
SHFileOperation_Copy2 = 0
Set fso = Nothing
Exit Function
ProcessError:
Messagebox "Problème sur Copie " & txtSource & " dans " & txtDestination
SHFileOperation_Copy2 = 1
Set fso = Nothing
Exit Function
End Function

Function FileExist2(filespec) As Integer

Dim fso
FileExist2=False
On Error Goto ProcessError
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(filespec)) Then
FileExist2=True
Else
FileExist2=False
End If
Exit Function
ProcessError:
FileExist2=False
Exit Function
End Function

Sub DeleteAFolder(filespec)

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder(filespec)

End Sub

Gravatar Image1 - Bonjour,


Si jamais tu vais les lignes de code permettant de faire de la copie de fichier, car je t'avoue que je tatonne mais je n'ai pas assez de compétences en lotus script.

Merci d'avance.

Post A Comment

:-D:-o:-p:-x:-(:-):-\:angry::cool::cry::emb::grin::huh::laugh::lips::rolleyes:;-)