renommer un fichier sélectionné dans un répertoire

Version imprimable

Bonjour,:)

Je m'adresse à vous pour savoir s'il est possible de renommer un fichier après l'avoir sélectionné dans un répertoire, j'ai un petit bout de code qui permet d'ouvrir l'explorer, mais comment récupérer le chemin complet du fichier sélectionné dans une variable et ensuite rechercher le texte saisie dans un MsgBox ou InputBox et le remplacé le texte saisie dans un second MsgBox ou InputBox ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Option Explicit Dim Saisie1, Saisie2, oShell, objFSO, chemin Set oShell = CreateObject("WScript.Shell") oShell.Run("explorer.exe /select, C:") Saisie1 = InputBox("Quelle chaine de caracteres voulez-vous remplacer ") If Saisie1 = "" Then WScript.Quit Saisie2 = InputBox("Par quelle chaine de caracteres voulez-vous remplacer la chaine ( " & Saisie1 & " ) ?") If Saisie2 = "" Then WScript.Quit 'chemin= chemin complet du fichier sélectionné Replace (chemin, "active", "desactive")
Merci d'avance pour votre aide.

11/01/2015, 14h47
hackoofr

[VBS]Dialogue "Sélectionner un fichier" toutes versions de Windows avec filtres et choix du répertoire initial

:salut:
Un coup d’œil ici ==> [VBS]Dialogue "Sélectionner un fichier" toutes versions de Windows avec filtres et choix du répertoire initial

Bonjour hackoofr,

Merci pour ta réponse

Après avoir consulté le lien que tu m'as indiqué, j'ai modifié mon

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
Dim Saisie1, Saisie2, chemin
Function GetFileDlg(sIniDir,sFilter,sTitle)
	GetFileDlg=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script><hta:application showintaskbar=no />""").StdOut.ReadAll
End Function
 
Function GetFileDlgBar(sIniDir,sFilter,sTitle)
	GetFileDlgBar=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script>""").StdOut.ReadAll
End Function
 
' exemple test
sIniDir = "C:\Windows\Fonts\*"
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"
 
' sIniDir doivent être conformes à la syntaxe JavaScript
chemin = GetFileDlg(Replace(sIniDir,"\","\\"),sFilter,sTitle)
MsgBox chemin '& vbcrlf & Len(rep)
 
Saisie1 = InputBox("Quelle chaine de caracteres voulez-vous remplacer ")
If Saisie1 = "" Then WScript.Quit
 
Saisie2 = InputBox("Par quelle chaine de caracteres voulez-vous remplacer la chaine ( " & Saisie1 & " ) ?")
If Saisie2 = "" Then WScript.Quit
 
'Replace (chemin, Saisie1, Saisie2)

La syntaxe Replace ne fonctionne pas ?

Avez-vous la solution.

:salut:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Function GetFileDlgEx(sIniDir,sFilter,sTitle) '"no limit" Browse dialog : the global size of the parameters isn't limited anymore
    Set oDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
    oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
    GetFileDlgEx = oDlg.StdOut.ReadAll
End Function
 
sIniDir = "C:\*"
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"
 
chemin = GetFileDlgEx(Replace(sIniDir,"\","\\"),sFilter,sTitle)
MsgBox chemin
 
Saisie1 = InputBox("Quelle chaine de caracteres voulez-vous remplacer ")
If Saisie1 = "" Then WScript.Quit
 
Saisie2 = InputBox("Par quelle chaine de caracteres voulez-vous remplacer la chaine ( " & Saisie1 & " ) ?")
If Saisie2 = "" Then WScript.Quit
 
MsgBox Replace(chemin,Saisie1,Saisie2)

11/01/2015, 18h52
modus57

Avec

Code:

MsgBox Replace(chemin,Saisie1,Saisie2)

Ça change rien la chaine de caractères n'est pas remplacée ???

Je continu à chercher une solution.

Finalement j'ai trouvé la solution :
Code:

1 2 3 4 newchemin= Replace(chemin,Saisie1,Saisie2) Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.MoveFile chemin , newchemin Set objFSO = Nothing
Merci beaucoup pour ton aide.

:salut:
Dans ce cas n'oubliez pas de passer la discussion en :resolu: et les +1 :plusser: aussi :mouarf:

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
Option Explicit
Dim objFSO,sIniDir,sFilter,sTitle,Chemin,Saisie1,Saisie2,Newchemin
Set objFSO = CreateObject("Scripting.FileSystemObject")
sIniDir = "C:\*"
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"
 
Chemin = GetFileDlgEx(Replace(sIniDir,"\","\\"),sFilter,sTitle)
MsgBox Chemin
 
Saisie1 = InputBox("Quelle chaine de caracteres voulez-vous remplacer ")
If Saisie1 = "" Then WScript.Quit
 
Saisie2 = InputBox("Par quelle chaine de caracteres voulez-vous remplacer la chaine ( " & Saisie1 & " ) ?")
If Saisie2 = "" Then WScript.Quit
 
Newchemin= Replace(chemin,Saisie1,Saisie2)
objFSO.MoveFile chemin,newchemin
Call Explore(newchemin)
Set objFSO = Nothing
'****************************************************************************************************
Function Explore(filename)
    Dim ws
    Set ws=CreateObject("wscript.Shell")
    ws.run "Explorer /n,/select,"& filename &" "
End Function
'****************************************************************************************************
Function GetFileDlgEx(sIniDir,sFilter,sTitle)
    Dim oDlg
    Set oDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
    oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
    GetFileDlgEx = oDlg.StdOut.ReadAll
End Function
'****************************************************************************************************

11/01/2015, 22h16
modus57

Bonsoir hackoofr,

Avant de marquer la discussion comme résolu, j'ai une question à vous poser :

- pourquoi le premier InputBox se mets en réduction dans la barre des tâches ???

Quelle est la solution à ce problème.

Bonsoir à tous, :D

Pour régler le problème du premier InputBox, qui finalement s'affiche en arrière plan, j'ai trouvé une solution :

Code:

1
2
Set objShell = CreateObject("WScript.Shell") 
objShell.SendKeys "% {F4}"

J'imagine que c'est pas la meilleure mais elle l'a le mérite de fonctionner.

Voici le script définitif :

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
Option Explicit
Dim objFSO,sIniDir,sFilter,sTitle,Chemin,objShell,Saisie1,Saisie2,Newchemin
Set objFSO = CreateObject("Scripting.FileSystemObject")
sIniDir = "C:\*"
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"
 
Chemin = GetFileDlgEx(Replace(sIniDir,"\","\\"),sFilter,sTitle)
'MsgBox Chemin
 
Set objShell = CreateObject("WScript.Shell") 
objShell.SendKeys "% {F4}"
 
Saisie1 = InputBox("Quelle chaine de caracteres voulez-vous remplacer")
If Saisie1 = "" Then WScript.Quit
 
Saisie2 = InputBox("Par quelle chaine de caracteres voulez-vous remplacer la chaine ( " & Saisie1 & " ) ?")
If Saisie2 = "" Then WScript.Quit
 
Newchemin= Replace(chemin,Saisie1,Saisie2)
objFSO.MoveFile chemin,newchemin
Call Explore(newchemin)
Set objFSO = Nothing
'****************************************************************************************************
Function Explore(filename)
    Dim ws
    Set ws=CreateObject("wscript.Shell")
    ws.run "Explorer /n,/select,"& filename &" "
End Function
'****************************************************************************************************
Function GetFileDlgEx(sIniDir,sFilter,sTitle)
    Dim oDlg
    Set oDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
    oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
    GetFileDlgEx = oDlg.StdOut.ReadAll
End Function
'****************************************************************************************************

:merci: