Bjr à tous  
voila j'ai une aplication à faire. On m'a conseiller le script qui est ci-dessous.Cela il n'est pas adapté.Je voudrais remplacer la saisi du lecteur ( par exemple k par la saisi d'un répertoire. (par ex: k:\...\)
et evidemment je ne m'y connais pas en programmation objet
quelqu'un saurait il m'aider?  
voilà le script :  
'Accèss au dossier d'un disque  
'  
Const CACHE = "Caché"  
Const SYSTEME = "Système"  
Const ARCHIVE = "Archive"  
Const LECTURE = "Lecture_Seulement"  
Const RACCOURCI = "Raccourci"  
Const COMPRESSE = "Compressé"  
 
'(24)  
' Déclaration des variables globales du programme  
 
Dim oLecteur 'ObjetLecteurDeDisque  
Dim oRepertoire 'ObjetRépertoire  
Dim oFS 'ObjetFileSystem  
Dim sOutput 'Variable d'écriture  
Dim oInfoLecteur 'Variable d'information sur le lecteur courant  
Dim oInfoFichier '(20)Variable d'information sur le fichier courant  
Dim Lecteur 'Variable du lecteur à lire  
Dim Disque 'Variable du lecteur à écrire  
Dim FichierEXCEL 'Variable du fichier de sortie  
Dim Fichier 'Variable du fichier de sortie  
'(Liste de tous les fichiers du lecteur demandé)  
Dim Flag 'Drapeau (logique)  
'  
 
Dim msgTexte 'Variable de message è l'usager  
Dim lngTexte 'Variable de la longueur d'une chaine de caractères  
'  
 
'  
' Déclaration des variables globales du classeur EXCEL  
'  
Dim xlApp, xlBook, xlChart, xlRange 'Objets classeur  
Dim xlWhs, iRows, iCols, iRotate 'Objets feuille  
 
'(51)Debut du programme  
'Sub Main()  
' (Attention, le label n'exite pas en VBS)  
 
Flag = False  
msgTexte = "Entrez le nom du fichier : " & vbCrLf & "(ex.: x:\local\_Admin\Stagiaire\matthieu\projet\stage.xls)"  
Fichier = InputBox(msgTexte, "Saisie du fichier à créer", "K:\Info.xls" )  
 
Set oFS = CreateObject("Scripting.FileSystemObject" )  
 
Set xlApp = CreateObject("Excel.Application" )  
 
If (FichierExistant(Fichier)=True) Then  
Set xlBook = xlApp.Workbooks.Open(Fichier)  
Flag = True  
Else  
xlApp.SheetsInNewWorkbook = 1  
Set xlBook = xlApp.Workbooks.Add  
End If  
 
'(71)  
 
Set xlWks = xlBook.Worksheets(1)  
Set xlRange = xlWks.Range("A1:A65535" )  
 
Disque = Mid(Fichier, 1, 2)  
 
Set oLecteur = oFS.GetDrive(Disque)  
 
If (oLecteur.IsReady) Then  
Lecteur = InputBox("Entrez la lettre du lecteur à lire :", "Saisie du lecteur à lire","K" )  
Set oLecteur = oFS.GetDrive(Lecteur)  
If (oLecteur.IsReady) Then  
Call Principal(Fichier)  
Else  
EnvoiMessage (0)  
End If  
Else  
EnvoiMessage (0)  
End If  
'  
'End Sub (Le label n'exite pas en VBS)  
' Fin de Programme  
'  
'(95)==========================================================================  
'  
Sub Principal(ByVal nomFichier)  
 
Dim Plage  
Dim Valeur  
Dim Boucle  
 
On Error Resume Next  
 
If (Flag = False) Then  
'Création de l'en-tête du fichier EXCEL  
xlRange.Cells(1, 1).Value = "Nom Fichier"  
xlRange.Cells(1, 2).Value = "Type Fichier"  
xlRange.Cells(1, 3).Value = "Grandeur"  
xlRange.Cells(1, 4).Value = "Chemin d'accès"  
xlRange.Cells(1, 5).Value = "Date Créé"  
xlRange.Cells(1, 6).Value = "Date Accédé"  
xlRange.Cells(1, 7).Value = "Date Modifié"  
xlRange.Cells(1, 8).Value = "Nom cours"  
xlRange.Cells(1, 9).Value = "Chemin cours"  
xlRange.Cells(1, 10).Value = "Version"  
xlRange.Cells(1, 11).Value = "Attr CACHÉ"  
xlRange.Cells(1, 12).Value = "Attr SYSTÈME"  
xlRange.Cells(1, 13).Value = "Attr ARCHIVE"  
xlRange.Cells(1, 14).Value = "Attr LECTURE SEULE"  
xlRange.Cells(1, 15).Value = "Attr RACCOURCI"  
xlRange.Cells(1, 16).Value = "Attr COMPRESSÉ"  
iRows = 2  
Else  
Boucle=1  
Valeur = xlRange.Cells(1,1).Value  
While (Valeur <> "" )  
Boucle = (Boucle + 1)  
Valeur = xlRange(Boucle,1)  
WEnd  
iRows = Boucle  
End If  
 
'(134)  
 
If (oLecteur.IsReady) Then  
'Lecture des fichiers dans la racine du lecteur  
If (oLecteur.RootFolder.Files.Count > 0) Then  
For Each oFichier In oLecteur.RootFolder.Files  
xlRange.Cells(iRows, 1).Value = oFichier.Name  
xlRange.Cells(iRows, 2).Value = oFichier.Type  
xlRange.Cells(iRows, 3).Value = oFichier.Size  
xlRange.Cells(iRows, 4).Value = oFichier.Path  
xlRange.Cells(iRows, 5).Value = oFichier.DateCreated  
xlRange.Cells(iRows, 6).Value = oFichier.DateLastAccessed  
xlRange.Cells(iRows, 7).Value = oFichier.DateLastModified  
xlRange.Cells(iRows, 8).Value = oFichier.ShortName  
xlRange.Cells(iRows, 9).Value = oFichier.ShortPath  
xlRange.Cells(iRows, 10).Value = ChercheVersion(oFichier.Name)  
 
Call ChercheAttributs (oFichier,CACHE,Reponse)  
xlRange.Cells(iRows, 11).Value = Reponse  
Call ChercheAttributs (oFichier,SYSTEME,Reponse)  
xlRange.Cells(iRows, 12).Value = Reponse  
Call ChercheAttributs (oFichier,ARCHIVE,Reponse)  
xlRange.Cells(iRows, 13).Value = Reponse  
Call ChercheAttributs (oFichier,LECTURE,Reponse)  
xlRange.Cells(iRows, 14).Value = Reponse  
Call ChercheAttributs (oFichier,RACCOURCI,Reponse)  
xlRange.Cells(iRows, 15).Value = Reponse  
Call ChercheAttributs (oFichier,COMPRESSE,Reponse)  
xlRange.Cells(iRows, 16).Value = Reponse  
 
'(164)  
 
iRows = (iRows + 1)  
xlApp.StatusBar = iRows  
If (iRows > 65534) Then  
xlApp.ActiveWorkbook.Worksheets.Add  
Set xlWks = xlBook.Worksheets(1)  
Set xlRange = xlWks.Range("A1:A65535" )  
iRows = 2  
End If  
Next  
End If  
 
'Lecture des sous-répertoires dans le lecteur  
For Each oRepertoire In oLecteur.RootFolder.SubFolders  
xlApp.Visible = True  
xlWks.Activate  
xlRange.Cells(1, 1).Select  
Call ListeFichier(oRepertoire)  
Next  
 
'(185)  
 
xlApp.Visible = True  
xlWks.Activate  
xlRange.Cells(1, 1).Select  
 
xlApp.DisplayAlerts = False  
xlBook.SaveAs nomFichier  
xlApp.Quit  
xlApp.DisplayAlerts = True  
 
Set xlRange = Nothing  
Set xlChart = Nothing  
Set xlWks = Nothing  
Set xlBook = Nothing  
Set xlApp = Nothing  
iRows = 0  
iCols = 0  
 
End If  
 
wscript.echo "Fin de traitement :-) "  
 
End Sub  
'  
'(210)==========================================================================  
'  
Function FichierExistant(NomFichier)  
 
Dim fso  
 
Set fso = CreateObject("Scripting.FileSystemObject" )  
FichierExistant = fso.FileExists(NomFichier)  
Set fso = Nothing  
 
End Function  
 
'  
'(223)==========================================================================  
'  
Function EnvoiMessage(ByVal Chiffre)  
 
Select Case Chiffre  
Case 0 msgTexte="Lecteur non disponible !"  
Case 1 msgTexte="Disponible !"  
Case 2 msgTexte="Disponible !"  
Case 3 msgTexte="Disponible !"  
Case 4 msgTexte="Disponible !"  
Case 5 msgTexte="Disponible !"  
Case 6 msgTexte="Disponible !"  
Case Else msgTexte="Code d'erreur inexistant !"  
End Select  
 
wscript.echo msgTexte  
 
End Function  
'  
'(242)==========================================================================  
'  
Sub ListeFichier(ByVal oRepertoire)  
 
Dim oDossier  
Dim Reponse  
 
On Error Resume Next  
 
If (oRepertoire.Files.Count > 0) Then  
For Each oFichier In oRepertoire.Files  
'PROPRIÉTÉ  
xlRange.Cells(iRows, 1).Value = oFichier.Name  
xlRange.Cells(iRows, 2).Value = oFichier.Type  
xlRange.Cells(iRows, 3).Value = oFichier.Size  
xlRange.Cells(iRows, 4).Value = oFichier.Path  
xlRange.Cells(iRows, 5).Value = oFichier.DateCreated  
xlRange.Cells(iRows, 6).Value = oFichier.DateLastAccessed  
xlRange.Cells(iRows, 7).Value = oFichier.DateLastModified  
xlRange.Cells(iRows, 8).Value = oFichier.ShortName  
xlRange.Cells(iRows, 9).Value = oFichier.ShortPath  
xlRange.Cells(iRows, 10).Value = ChercheVersion(oFichier.Name)  
 
Call ChercheAttributs (oFichier,CACHE,Reponse)  
xlRange.Cells(iRows, 11).Value = Reponse  
Call ChercheAttributs (oFichier,SYSTEME,Reponse)  
xlRange.Cells(iRows, 12).Value = Reponse  
Call ChercheAttributs (oFichier,ARCHIVE,Reponse)  
xlRange.Cells(iRows, 13).Value = Reponse  
Call ChercheAttributs (oFichier,LECTURE,Reponse)  
xlRange.Cells(iRows, 14).Value = Reponse  
Call ChercheAttributs (oFichier,RACCOURCI,Reponse)  
xlRange.Cells(iRows, 15).Value = Reponse  
Call ChercheAttributs (oFichier,COMPRESSE,Reponse)  
xlRange.Cells(iRows, 16).Value = Reponse  
 
iRows = (iRows + 1)  
If (iRows > 65534) Then  
xlApp.ActiveWorkbook.Worksheets.Add  
Set xlWks = xlBook.Worksheets(1)  
Set xlRange = xlWks.Range("A1:A65535" )  
iRows = 2  
End If  
Next  
End If  
 
If (oRepertoire.SubFolders.Count > 0) Then  
For Each oDossier In oRepertoire.SubFolders  
Call ListeFichier(oDossier)  
Next  
End If  
 
End Sub  
'  
'(297)==========================================================================  
'  
Function ChercheAttributs (ByVal oFichier,ByVal Validation, ByRef Reponse)  
 
On Error Resume Next  
Reponse = "Aucun"  
 
Select Case (Validation)  
Case (LECTURE)  
If (oFichier.Attributes AND 1) Then  
Reponse = "Activer" 'Read-only = VRAI  
Else  
Reponse = "Désactiver" 'Read-only = FAUX  
End If  
 
Case (CACHE)  
If (oFichier.Attributes AND 2) Then  
Reponse = "Activer" 'Hidden file = VRAI  
Else  
Reponse = "Désactiver" 'Hidden file = FAUX  
End If  
 
Case (SYSTEME)  
If (oFichier.Attributes AND 4) Then  
Reponse = "Activer" 'System file = VRAI  
Else  
Reponse = "Désactiver" 'System file = FAUX  
End If  
 
Case (ARCHIVE)  
If (oFichier.Attributes AND 32) Then  
Reponse = "Activer" 'Archive bit = VRAI  
Else  
Reponse = "Désactiver" 'Archive bit = FAUX  
End If  
 
Case (RACCOURCI)  
If (oFichier.Attributes AND 64) Then  
Reponse = "Activer" 'ShortCut = VRAI  
Else  
Reponse = "Désactiver" 'ShortCut = FAUX  
End If  
 
Case (COMPRESSE)  
If (oFichier.Attributes AND 2048) Then  
Reponse = "Activer" 'Compressed file = VRAI  
Else  
Reponse = "Désactiver" 'Compressed file = FAUX  
End If  
 
Case Else Reponse = "Aucun"  
 
End Select  
 
End Function  
'  
'(353)==========================================================================  
 
 
merci pour vos rep  
 
matthieu