Discussion :

[modus57]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[hackoofr]

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

[modus57]

Bonjour hackoofr,

Merci pour ta réponse

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[hackoofr]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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)

[modus57]

Avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox Replace(chemin,Saisie1,Saisie2)

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

Je continu à chercher une solution.

[modus57]

Finalement j'ai trouvé la solution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[hackoofr]

Dans ce cas n'oubliez pas de passer la discussion en et les +1 aussi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'****************************************************************************************************

[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.

[modus57]

Bonsoir à tous,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'****************************************************************************************************