Vbscript
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?
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
-
ContributeurSalut,
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...
-
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?
-
ContributeurAs tu essayé GetFolder ?
-
GetFolder?
c'est quoi?
dsl pour la question stupide mais je m'y connais pas en programation objet lol -
Contributeurbonjour
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.
-
ok merci
ben vais encore me galérer un peu pis si je bloque encore ben...
je continurais cette joli discussion
bonne journée -
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 -
ContributeuroFS.GetFolder!
-
ok merci
je teste
-
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? -
re
Disque = Mid(Fichier, 1, 2) faut peut etre pas supprimer mais modifier non?
-
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?? -
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! -
bjr à tous!
j'ai tjs besoin d'aide
dc svp les têtes en programmation...
merci de votre aide -
re
ya toujours personne pour m'aider?? -
ContributeurBen déjà si tu donnais l'erreur...
-
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! -
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
-
Bonjour,
Voilà, j'ai trouvé votre souci intéressant, alors j'ai modifé
le code de façon a obtenir la saisie d'un répertoire et/ou
sous-répertoire.
suivez le lien :
http://www.oricom.ca/lupin/document/excelvbs.txt
Lupin
-
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!!
