VBScript : Script deplacement enregistrement TV

Version imprimable

Bonjour ! ,
Je souhaite déplacer certains enregistrement vers mon serveur pour les partager sur le réseau, je me suis donc tourné vers un script VBs. J'ai écrit un script cependant celui-ci ne fait rien et ne généré pourtant aucune erreur :( .

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
  Dim fso
  Dim oSourceFolder
  Dim oSubFolder
  Dim oFile
  Dim oFolder
  Dim strFolderName
  Dim i
  Dim destfile
  Dim Ftxt
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
   'Dossier source des enregitrements 
   strFolderName = "C:\Users\Public\Recorded TV\"
 
   'Dossier de destination
   destfile = "C:\Users\Public\Recorded TV\Sample Media"
 
  Set oFolder = fso.GetFolder(strFolderName)
 
 
            For Each oFile In oFolder.Files
 
              'Je vérifie que le fichier correspond a mes critères  
             If (oFile Like (oFolder & "\" & "*_TF1_*.wtv")) Or (oFile Like (oFolder & "\" & "*_M6_*.wtv")) Then
 
              'Déplacement du fichier
              Set Ftxt = fso.GetFile(oFile)   
              Ftxt.Move (destfile & "\" & oFile.Name) 
            End If
 
            Next

Je pense que ce code est fonctionnel car sinon j'aurais une erreur ?
merci pour votre aide

09/05/2009, 18h59
SfJ5Rpw8

à première vue je vois rien .. mais rajoute des messages pour suivre le déroulement de ton script ... du genre :

Code:

wscript.echo strFolderName

Code:

wscript.echo ofile.Name

... à placer aux bons endroits, avant une boucle puis dans la boucle...
09/05/2009, 21h38
frco9

ok je vais essayer avec pour voir ce qui se passe. Ensuite je sais pas si c'est pareille :roll: , mais j'ai testé mon code en l'incluant dans une macro de vba et ça marche 8O bizard, je vous tiens au courant merci de m'aider !

Edit : Alors j'ai essayé d'ajouter les lignes que vous m'avez indiquées à différent endroits en changeant les variables. Cependant dès que je double clique sur l'icône de mon script rien ne se passe, et si je fais "clique droit, ouvrir avec l'invite de commande" et bien il ne se passe toujours rien : j'entrevois la console qui s'ouvre mais elle se ferme instantanément :cry:
09/05/2009, 22h23
ProgElecT

Code:

destfile = "C:\Users\Public\Recorded TV\Sample Media"

Peut être un problème d'espace dans le(s) nom(s) des dossiers.
Je ne suis pas spécialiste de VBScript, mais il me semble bien avoir lut différentes discussions signalant ce probléme.
09/05/2009, 22h26
SfJ5Rpw8

Citation:

Envoyé par frco9

...l'invite de commande" et bien il ne se passe toujours rien : j'entrevois la console qui s'ouvre mais elle se ferme instantanément :cry:

passe en ligne de commande, menu Exécuter puis cmd

place toi sur le bon dossier (celui qui contient ton vbs ) à grand renfort de

Code:

cd monrepertoire

puis execute ton vbs :

Code:

monScript

Alors :
J'ai testé l'execution avec la console "cmd" etc mais ça fais rien ci-dessous les lignes de la console :

Code:

1
2
C:\Users\Jeremie\Desktop>test.vbs
C:\Users\Jeremie\Desktop>

Le plus bizarre c'est que j'ai mis des echo comme vous me l'aviez conseillé donc je devrais au moins avoir le premier voila mon code avec les echo :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
  Dim fso
  Dim oSourceFolder
  Dim oSubFolder
  Dim oFile
  Dim oFolder
  Dim strFolderName
  Dim i
  Dim destfile
  Dim Ftxt
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
   strFolderName = "C:\Users\Public\Recorded TV\"
   destfile = "C:\Users\Public\Recorded TV\Sample Media"
	wscript.echo strFolderName
 
  Set oFolder = fso.GetFolder(strFolderName)
  	wscript.echo oFolder
 
            For Each oFile In oFolder.Files
              wscript.echo oFile 
             If (oFile Like (oFolder & "\" & "*_TF1_*.wtv")) Or (oFile Like (oFolder & "\" & "*_M6_*.wtv")) Then
              'Déplacement du fichier
              Set Ftxt = fso.GetFile(oFile)   'Fichier origine
              Ftxt.Move (destfile & "\" & oFile.Name) 'emplacement destination
            End If
 
            Next

Donc c'est peut être effectivement une histoire d'espace comme la dit ProgElect. Y a t'il un moyen de le contourner ou voyez-vous une autre source au problème

09/05/2009, 22h58
SfJ5Rpw8

peu-être une mauvaise option d'en registré essai :

Code:

cscript //D test.vbs
09/05/2009, 23h03
frco9
:oops: Désolé, c'est peut etre con mais je sais pas ou la mettre votre commande :mouarf: ! J'execute dans une console dans le bon dossier ?

Edit : J'ai executer la commande voila ce que j'obtient :
Code:

1 2 Microsoft <R> Windows Script Host Version 5.8 Copyright <C> Microsoft Corporation 1992-2001. Tous droits réservés.
J'ai essayé de le reexecuter mais ça a rien changé :(
09/05/2009, 23h04
SfJ5Rpw8

en console

Code:

C:\Users\Jeremie\Desktop>cscript //D test.vbs
09/05/2009, 23h08
frco9

plus rapide ^^ voir reponse plus haut :P
10/05/2009, 13h51
frco9
Citation:
Envoyé par frco9

J'ai executer la commande voila ce que j'obtient :

Code:

1 2 Microsoft <R> Windows Script Host Version 5.8 Copyright <C> Microsoft Corporation 1992-2001. Tous droits réservés.

J'ai essayé de le reexecuter mais ça a rien changé :(

Si le(s) espaces(s) et/ou le(s) nom(s) long(s) peuvent être en causes, cette fonction pourra te rendre service, rien ne coute de faire l’essai.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Public Function ConvertNomCourt(ChemFic)
'cette fonction convertie un chemin dossier et fichier en nom long
'vers un chemin et fichier cours
'exemple:
'       C:\PersoFrancis\Utilisation de Scripting\Projet1.vbp
'       C:\PERSOF~1\UTILIS~1\Projet1.vbp
Dim f , fs
Dim T
Dim Compos, Progra
 
Set fs = CreateObject("Scripting.FileSystemObject")
Compos = Split(ChemFic, "\")
Progra = Compos(0) & "\" 'recuperation de la lettre du disque
'ajout de la chaine de chaque dossier
For T = 1 To UBound(Compos) - 1
 Set f = fs.GetFolder(Progra & Compos(T))
 Progra = Progra & f.ShortName & "\"
Next
'ajout du nom du fichier
Set f = fs.GetFile(Progra & Compos(UBound(Compos)))
Progra = Progra & f.ShortName
'nettoyage
Set f = Nothing
Set fs = Nothing
ConvertNomCourt = Progra
End Function

Illustration de l'utilisaton de la fonction ConvertNomCourt

Code:

1
2
3
Dim Msg
Msg = "Chemin complet à transformer" '<===== addapter
msgbox Msg  & vbcrlf & "devient:" & vbcrlf & ConvertNomCourt (Msg)

Motif de l'edit
Desolé, j'ai corrigé: ConvertNomCourt (Msg) non pas ==> ConvertNomCourt ("Msg")

Merci pour la réponse, j'ai ajouter ça au script voila le résultat c'est bon ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
 
  Dim fso
  Dim oSourceFolder
  Dim oSubFolder
  Dim oFile
  Dim oFolder
  Dim strFolderName
  Dim i
  Dim destfile
  Dim Ftxt
  Dim sourcenew
  Dim destnew
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
   strFolderName = "C:\Users\Public\Recorded TV\"
   sourcenew = ConvertNomCourt("strFolderName")
   destfile = "C:\Users\Public\Recorded TV\Sample Media"
   destnew = ConvertNomCourt("destfile")
    wscript.echo strFolderName
 
  Set oFolder = fso.GetFolder(sourcenew)
    wscript.echo oFolder
 
            For Each oFile In oFolder.Files
              wscript.echo oFile
             If (oFile Like (oFolder & "\" & "*_TF1_*.wtv")) Or (oFile Like (oFolder & "\" & "*_M6_*.wtv")) Then
              'Déplacement du fichier
              Set Ftxt = fso.GetFile(oFile)   'Fichier origine
              Ftxt.Move (destnew & "\" & oFile.Name) 'emplacement destination
            End If
 
            Next
 
 
 
Public Function ConvertNomCourt(ChemFic)
'cette fonction convertie un chemin dossier et fichier en nom long
'vers un chemin et fichier cours
'exemple:
'       C:\PersoFrancis\Utilisation de Scripting\Projet1.vbp
'       C:\PERSOF~1\UTILIS~1\Projet1.vbp
Dim f, fs
Dim T
Dim Compos, Progra
 
Set fs = CreateObject("Scripting.FileSystemObject")
Compos = Split(ChemFic, "\")
Progra = Compos(0) & "\" 'recuperation de la lettre du disque
'ajout de la chaine de chaque dossier
For T = 1 To UBound(Compos) - 1
 Set f = fs.GetFolder(Progra & Compos(T))
 Progra = Progra & f.ShortName & "\"
Next
'ajout du nom du fichier
Set f = fs.GetFile(Progra & Compos(UBound(Compos)))
Progra = Progra & f.ShortName
'nettoyage
Set f = Nothing
Set fs = Nothing
ConvertNomCourt = Progra
End Function

J'ai testé ce code et malheureusement ça fais toujours rien :cry:

Code:

1
2
3
4
   strFolderName = "C:\Users\Public\Recorded TV\"
   sourcenew = ConvertNomCourt("strFolderName")
   destfile = "C:\Users\Public\Recorded TV\Sample Media"
   destnew = ConvertNomCourt("destfile")

Là tu passe le nom des variables.
Il te faut passer le contenu des variables

Code:

1
2
3
4
   strFolderName = "C:\Users\Public\Recorded TV\"
   sourcenew = ConvertNomCourt(strFolderName)
   destfile = "C:\Users\Public\Recorded TV\Sample Media"
   destnew = ConvertNomCourt(destfile)

10/05/2009, 18h55
frco9

Oups :oops: , désolé, j'ai modifier mais ça change rien quand je passe le code dans visual basic en mode debuggeur, il bloque a la ligne

Code:

Set f = fs.GetFile(Progra & Compos(UBound(Compos)))

Je sais pas si ça a quelquechose a voir :?

Dans la fonction ajoute cette ligne

Code:

1
2
3
4
5
6
7
 Progra = Progra & f.ShortName & "\"
Next
'ajout du nom du fichier
 
msgbox Progra & Compos(UBound(Compos)) ' <==== ICI ======
 
Set f = fs.GetFile(Progra & Compos(UBound(Compos)))

10/05/2009, 19h20
frco9

J'ai ajouter la ligne et ça m'affiche bien la msgbox avec noté

Citation:

C:\Users\Public\RECORD~1~\

et ensuite j'ai une erreur :

Citation:

Script: C:\User\ etc....
Ligne: 59
Caract. : 1
Erreur: Fichier introuvable
Code: 800A0035
Source : Erreur d'exécution Microsoft VBScript

:oops:
Desolé encor une fois, j'ai revue ma copie :aie:
La fonction

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Public Function ConvertNomCourt(ChemFic, Quoi)
'si Quoi <> F
'cette fonction convertie un non de chemin Dossier(s) Long en
'nom de chemin Dossier(s) cours
'si Quoi = F
'cette fonction convertie un non de chemin Dossier(s) et Fichier Long en
'nom de chemin Dossier(s) et Fichier cours
Dim f , fs
Dim T
Dim Compos, Progra
 
Set fs = CreateObject("Scripting.FileSystemObject")
Compos = Split(ChemFic, "\")
Progra = Compos(0) & "\" 'recuperation de la lettre du disque
'ajout de la chaine de chaque dossier
For T = 1 To UBound(Compos) - 1
 Set f = fs.GetFolder(Progra & Compos(T))
 Progra = Progra & f.ShortName & "\"
Next
 
if Quoi="F" then
 'ajout du nom du fichier
 Set f = fs.GetFile(Progra & Compos(UBound(Compos)))
 else
 'ajout du nom du dossier le plus profond
 Set f = fs.GetFolder(Progra & Compos(T))
end if
Progra = Progra & f.ShortName
 
'nettoyage
Set f = Nothing
Set fs = Nothing
ConvertNomCourt = Progra
End Function

La façon de l'utiliser

Code:

1
2
3
4
5
6
7
Dim Msg
'pour convertire un chemin sans le fichier
Msg = "C:\PersoFrancis\Utilisation de Scripting" '<===== addapter
msgbox  Msg  & vbcrlf & "devient:" & vbcrlf & ConvertNomCourt (Msg,"")
'pour convertire un chemin et son fichier
Msg = "C:\PersoFrancis\Utilisation de Scripting\Projet1.vbp" '<===== addapter
msgbox  Msg  & vbcrlf & "devient:" & vbcrlf & ConvertNomCourt (Msg,"F")

J'ai ajouté un indicateur, Quoi pour la fonction, car dans la premiere mise quelques post plus haut, il fallait que le chemin et le fichier soit soumis, maintenant avec le paramettre Quoi cette fonction peut renvoyer les deux possibilités.

Bon ba desolé mais ça marche toujours pas ^^ le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
 Dim fso
  Dim oSourceFolder
  Dim oSubFolder
  Dim oFile
  Dim oFolder
  Dim strFolderName
  Dim i
  Dim destfile
  Dim Ftxt
  Dim sourcenew
  Dim destnew
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
   strFolderName = "C:\Users\Public\Recorded TV\"
   sourcenew = ConvertNomCourt (strFolderName,"")
   destfile = "C:\Users\Public\Recorded TV\Sample Media"
   destnew = ConvertNomCourt (destfile,"")
 
    wscript.echo strFolderName
 
  Set oFolder = fso.GetFolder(sourcenew)
    wscript.echo oFolder
 
            For Each oFile In oFolder.Files
              wscript.echo oFile
             If (oFile Like (oFolder & "\" & "*_TF1_*.wtv")) Or (oFile Like (oFolder & "\" & "*_M6_*.wtv")) Then
              'Déplacement du fichier
              Set Ftxt = fso.GetFile(oFile)   'Fichier origine
              Ftxt.Move (destnew & "\" & oFile.Name) 'emplacement destination
            End If
 
            Next
 
 
 
Public Function ConvertNomCourt(ChemFic, Quoi)
'si Quoi <> F
'cette fonction convertie un non de chemin Dossier(s) Long en
'nom de chemin Dossier(s) cours
'si Quoi = F
'cette fonction convertie un non de chemin Dossier(s) et Fichier Long en
'nom de chemin Dossier(s) et Fichier cours
Dim f , fs
Dim T
Dim Compos, Progra
 
Set fs = CreateObject("Scripting.FileSystemObject")
Compos = Split(ChemFic, "\")
Progra = Compos(0) & "\" 'recuperation de la lettre du disque
'ajout de la chaine de chaque dossier
For T = 1 To UBound(Compos) - 1
 Set f = fs.GetFolder(Progra & Compos(T))
 Progra = Progra & f.ShortName & "\"
Next
 
if Quoi="F" then
 'ajout du nom du fichier
 Set f = fs.GetFile(Progra & Compos(UBound(Compos)))
 else
 'ajout du nom du dossier le plus profond
 Set f = fs.GetFolder(Progra & Compos(T))
end if
Progra = Progra & f.ShortName
 
'nettoyage
Set f = Nothing
Set fs = Nothing
ConvertNomCourt = Progra
End Function

J'espère ne pas avoir fais d'erreur :roll:

lorsque j'execute, j'ai la msgbox puis cette erreur

Citation:

Script: C:\User\ etc....
Ligne: 24
Caract. : 3
Erreur: Chemin d'accès introuvable
Code: 800A004C
Source : Erreur d'exécution Microsoft VBScript

Code:

1 2 3 4 5 6 7 8 Set fso = CreateObject("Scripting.FileSystemObject") strFolderName = "C:\Users\Public\Recorded TV\" sourcenew = ConvertNomCourt (strFolderName,"") msgbox sourcenew '<==================================== destfile = "C:\Users\Public\Recorded TV\Sample Media" destnew = ConvertNomCourt (destfile,"") msgbox destnew '<====================================
Citation:

Script: C:\User\ etc....
Ligne: 24
Caract. : 3

pour moi sa tombe sur une ligne blanche, ajoute les 2 lignes msgbox pour au moins savoir si sa beug au niveau de la fonction, si oui, un de tes chemins strFolderName ou destfile n'ai pas valide, car apres plusieurs essais de mon coté, pas de problème.
Ce qui m'embête le plus pour toi est que

Citation:

mais j'ai testé mon code en l'incluant dans une macro de vba et ça marche bizard, je vous tiens au courant merci de m'aider !

8O

Alors : Non, ça ne tombe pas sur une ligne blanche ^^ mais le chemins est il me semble faux. Dans l'ordre le resultat des msgbox

Citation:

C:\Users\Public\RECORD~1~\RECORD~1

Citation:

C:\Users\Public\RECORD~1~\SAMPLE~1

Une question est-ce normal que ce chemin ne fonctionne pas lorsque je l'utilise dans l'explorer windows ?

Pour revenir aux sources, j'ai créé un dossier sans espace ou j'ai mis mes fichiers pour voir, et bien vbs me renvoit une erreur :

le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 Dim fso Dim oSourceFolder Dim oSubFolder Dim oFile Dim oFolder Dim strFolderName Dim i Dim destfile Dim Ftxt Dim sourcenew Dim destnew Set fso = CreateObject("Scripting.FileSystemObject") strFolderName = "C:\TVtest\" destfile = "C:\TVtest\dep" Set oFolder = fso.GetFolder(strFolderName) For Each oFile In oFolder.Files If (oFile Like (oFolder & "\" & "*_TF1_*.wtv")) Or (oFile Like (oFolder & "\" & "*_M6_*.wtv")) Then 'Déplacement du fichier Set Ftxt = fso.GetFile(oFile) 'Fichier origine Ftxt.Move (destfile & "\" & oFile.Name) 'emplacement destination End If Next
Maintenant l'erreur :

Citation:

Script: C:\User\ etc....
Ligne: 25
Caract. : 14
Erreur: Sub ou Function non définie
Code: 800A0023
Source : Erreur d'exécution Microsoft VBScript

Je suis si nul que ça :cry: je sais meme pas ecrire un test en if :aie:

Citation:

Une question est-ce normal que ce chemin ne fonctionne pas lorsque je l'utilise dans l'explorer windows ?

Je suis sous VISTA famillial
En lui mettant le nom cours, pas de problème sur mon ordi.

Je fini par me demander si la fonction Like existe sous VBScript
voir cette discussion

j'ai fait les repertoires voulues et mis 8 fichiers .txt commencant par Prem et Deux dans le dossier C:\TVtest\ et suite a ce code ils ce retrouvent bien dans le dossier C:\TVtest\dep
Donc avec Instr cela devient
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 Dim fso Dim oSourceFolder Dim oSubFolder Dim oFile Dim oFolder Dim strFolderName Dim i Dim destfile Dim Ftxt Dim sourcenew Dim destnew Set fso = CreateObject("Scripting.FileSystemObject") strFolderName = "C:\TVtest\" destfile = "C:\TVtest\dep" Set oFolder = fso.GetFolder(strFolderName) For Each oFile In oFolder.Files 'msgbox oFile.name If instr(1,oFile.Name,"Prem") or instr(1,oFile.Name,"Deux") Then 'Déplacement du fichier 'msgbox oFile.name Set Ftxt = fso.GetFile(oFile) 'Fichier origine Ftxt.Move (destfile & "\" & oFile.Name) 'emplacement destination End If Next
A toi de voir la suite pour l'addapter ;)

10/05/2009, 21h52
frco9

Ok merci je vais étudier tous ça d'ici demain, merci pour l'aide je te tiens au courant quant au chemin avec nom cours c'est a dire ? :

Citation:

C:\Users\Public\RECORD~1~\RECORD~1

Je viens de passer a seven mais je pense pas que ça change quelque chose :?

PS : quant au LIKE on ne peut pas vraiment se fier a tous les sites.
10/05/2009, 22h04
ProgElecT

Citation:

Envoyé par frco9

Ok merci je vais étudier tous ça d'ici demain, merci pour l'aide je te tiens au courant quant au chemin avec nom cours c'est a dire ? :

Je viens de passer a seven mais je pense pas que ça change quelque chose :?

PS : quant au LIKE on ne peut pas vraiment se fier a tous les sites.

Si a DVP :mouarf:
J'attend ta solution, on en apprend tous les jours, donc les conclusions d'une discussion avec un code qui a resolu le problème est apprécier de tous.
A+

:salut:

:king: Bon merci beaucoup maintenant je sais ou venir si j'ai un problème. Le problème était bien le LIKE maintenant avec le instr ça marche très bien. Je te remerci voila le code final :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Dim fso
  Dim oSourceFolder
  Dim oSubFolder
  Dim oFile
  Dim oFolder
  Dim strFolderName
  Dim i
  Dim destfile
  Dim Ftxt
  Dim sourcenew
  Dim destnew
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
   strFolderName = "C:\Users\Public\Recorded TV\"
 
   destfile = "\\server\Index System\TV"
 
 
  Set oFolder = fso.GetFolder(strFolderName)
 
 
            For Each oFile In oFolder.Files
              'msgbox oFile.name
             If instr(1,oFile.Name,"TF1") or instr(1,oFile.Name,"M6") or instr(1,oFile.Name,"W9") Then
              'Déplacement du fichier
              'msgbox oFile.name
              Set Ftxt = fso.GetFile(oFile)   'Fichier origine
              Ftxt.Move (destfile & "\" & oFile.Name) 'emplacement destination
            End If
 
            Next

A une prochaine fois je l'espère !