Vbscript

Sacred Messages postés 679 Statut Membre -  
Sacred Messages postés 679 Statut Membre -
Bjr à tous
voila j'ai trouvé un script un script qui correspondrait à une appli que je voudrais faire mais j'ai un problème sur le code.(Je ne connais pas pas la programmation objet!! :( )
Dans le script il demande de saisir une lettre de lecteur (par exemple c:) . Je voudrais remplacer la saisi du lecteur par la saisi d'un répertoire.
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

--
wait worry who cares?

20 réponses

  1.
    teebo Messages postés 33585 Date d'inscription   Statut Contributeur Dernière intervention   1 797
     
    Salut,

    Heu...tu éspères vraiment qu'on se tape tout le code? Tu veux quoi exactement j'ai survolé et apparement il te demande le nom d'un fichier non?
    Qui plus est VBS n'est pas de l'objet...ceci dit en passant...

    0
  2. Sacred Messages postés 679 Statut Membre 77
     
    le fichier demandé est le fichier .xls a créer (bon ca on s'en fou yen a besoin
    ce ki me gene c'est cette partie :

    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

    car je veux pas qu'il prenne les info sur le disque entier comme dans l'exemple il va tout prendre dans k:
    moi j'aimerais qu'il prenne les info dans un répertoire par exemple k:\document
    c'est le seul pointdu prog que j'aimerais modifier
    tu vois ce que je veux dire?

    0
  3. teebo Messages postés 33585 Date d'inscription   Statut Contributeur Dernière intervention   1 797
     
    As tu essayé GetFolder ?
    0
  4. Sacred Messages postés 679 Statut Membre 77
     
    GetFolder?
    c'est quoi?
    dsl pour la question stupide mais je m'y connais pas en programation objet lol
    0
    1. teebo Messages postés 33585 Date d'inscription   Statut Contributeur Dernière intervention   1 797
       
      Ben c'est comme le GetDrive mais pour un répertoire...

      Et ce n'est pas de l'objet :-P
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
     
    bonjour

    Lecteur = InputBox("Entrez la lettre du lecteur à lire :", "Saisie du lecteur à lire","K")
    Set oLecteur = oFS.GetDrive(Lecteur)

    c'est cette instruction qui fait saisir le lecteur.

    il faudrait donc la remplacer par la recherche du répertoire,
    mais ce n'est plus le même objet et il n'a plus les mêmes propiétés.

    c'est comme lorsque tu utilises un tiroir pour ranger,
    tu ne peux pas pratiquer de la même façon qu'avec une étagère.

    0
  7. Sacred Messages postés 679 Statut Membre 77
     
    ok merci
    ben vais encore me galérer un peu pis si je bloque encore ben...
    je continurais cette joli discussion
    bonne journée
    0
  8. Sacred Messages postés 679 Statut Membre 77
     
    re
    et c'est le drame
    voila ma modif :

    Dim Chemin 'CheminDacces
    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")

    Chemin = GetFolder(Repertoire)

    If (Chemin.IsReady) Then
    Chemin = InputBox("Entrez lerépertoire à lire :", "Saisie du répertoire","x:\local")
    Set oLecteur = oFS.GetDrive(Lecteur)
    If (Chemin.IsReady) Then
    Call Principal(Fichier)
    Else
    EnvoiMessage (0)
    End If
    Else
    EnvoiMessage (0)
    End If

    et vla mon pb
    ligne : 64 (correspond à Chemin = GetFolder(Repertoire) )
    Caract. : 5
    Erreur type incompatible: 'getFolder'
    code : 800A000D

    help
    0
  9. teebo Messages postés 33585 Date d'inscription   Statut Contributeur Dernière intervention   1 797
     
    oFS.GetFolder!
    0
  10. Sacred Messages postés 679 Statut Membre 77
     
    ok merci
    je teste
    0
  11. Sacred Messages postés 679 Statut Membre 77
     
    slt
    je sens que ne je nage plus horizontalement mais verticalement!! ;)

    Disque = Mid(Fichier, 1, 2) // j'ai supp
    Set oChemin = oFS.GetFolder(Chemin)
    If (oChemin.IsReady) Then
    Chemin = InputBox("Entrez le répertoire à lire :", "Saisie du répertoire","K;\...\")
    Set oChemin = oFS.GeFolder(Chemin)
    If (oChemin.IsReady) Then
    Call Principal(Fichier)
    Else
    EnvoiMessage (0)
    End If
    Else
    EnvoiMessage (0)
    End If

    new pb
    ligne 64 (tjs la meme grrr)
    caract 5
    Erreur : argument ou appel de procedure incorrect
    code 800A0005

    une idée?
    0
  12. Sacred Messages postés 679 Statut Membre 77
     
    re
    Disque = Mid(Fichier, 1, 2) faut peut etre pas supprimer mais modifier non?
    0
  13. Sacred Messages postés 679 Statut Membre 77
     
    j'ai peut etre une piste la variable Chemin n'a pas été déclaré!!
    pffff ke dirait mon prof d'algo!!! lol
    Disque = Mid(Fichier, 1, 2) // c'est a modifier bon ça ok
    mais par quoi??
    0
  14. Sacred Messages postés 679 Statut Membre 77
     
    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")
    toute cette parti je l'ai passer en commentaire pour essayer de forcer le chemin

    et xlWks = xlBook.Worksheets(1)
    Set xlRange = xlWks.Range("A1:A65535")

    Chemin = "x:\local\_Admin\Stagiaire\matthieu" // mettre en place variable Chemin // ==> j'ai rentré direct le chemin pour forcer le choix du rep

    Set oChemin = oFS.GetFolder(Chemin)

    If (oChemin.IsReady) Then
    Chemin = InputBox("Entrez la lettre du lecteur à lire :", "Saisie du lecteur à lire","K")
    Set oChemin = oFS.GetDrive(Lecteur)
    If (oChemin.IsReady) Then
    Call Principal(Fichier)
    Else
    EnvoiMessage (0)
    End If
    Else
    EnvoiMessage (0)
    End If
    '
    'End Sub (Le label n'exite pas en VBS)

    mais ca marche toujours pas
    une petite aide serait bienvenue!
    0
  15. Sacred Messages postés 679 Statut Membre 77
     
    bjr à tous!
    j'ai tjs besoin d'aide
    dc svp les têtes en programmation...
    merci de votre aide
    0
  16. Sacred Messages postés 679 Statut Membre 77
     
    re
    ya toujours personne pour m'aider??
    0
  17. teebo Messages postés 33585 Date d'inscription   Statut Contributeur Dernière intervention   1 797
     
    Ben déjà si tu donnais l'erreur...
    0
  18. Sacred Messages postés 679 Statut Membre 77
     
    voila le début du script :

    Dim oChemin 'ObjetChemin d'acces
    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 Chemin '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
    '

    'l30
    ' 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")

    et xlWks = xlBook.Worksheets(1)
    Set xlRange = xlWks.Range("A1:A65535")

    Chemin = "x:\local\_Admin\Stagiaire\matthieu"
    Set oChemin = oFS.GetFolder(Chemin)
    If (oChemin.IsReady) Then
    Chemin = InputBox("Entrez la lettre du lecteur à lire :", "Saisie du lecteur à lire","K")
    Set oChemin = oFS.GetDrive(Lecteur)
    If (oChemin.IsReady) Then
    Call Principal(Fichier)
    Else
    EnvoiMessage (0)
    End If
    Else
    EnvoiMessage (0)
    End If
    '
    'End Sub (Le label n'exite pas en VBS)

    mon erreur c'est ligne 44 (Set xlRange = xlWks.Range("A1:A65535") )
    erreur : objet requis:"

    voila sinon en revenant au début de la discution tu pourra voir ce que doit faire le script ainsi que le script original

    ps merci d'avoir repondu ==> je commençais à desepérer!
    0
  19. Utilisateur anonyme
     
    Bonjour,

    je reconnais ce code, j'y jette un coup d'oeil pour apporter
    la modif dont tu as besoin.

    en attendant, attention la routine ListeFichier est récursive :)

    Lupin
    0
  21. Sacred Messages postés 679 Statut Membre 77
     
    j'ai pu voir hier soir avec un ami développeur
    il a réussi à m'aider
    ==> pb résolu
    merci à tous ceux qui m'ont aider!!
    0

Discussions similaires

Faire une pause en VBS
quent -
quent -

3 réponses
Pause dans un Script VB
avrelbct -
avrelbct -

1 réponse
[VBS] Script en pause pendant execution DOS
xav3601 -
xav3601 -

19 réponses
probleme vbscript
Dameuhien -
sud -

5 réponses
VBScript : Terminer l'exécution
-Shadow- -
-Shadow- -

7 réponses