Code vbs ne fonctionnant plus

**Superpat9999** · 25/11/2013, 11h32

Bonjour,

Je suis sous Windows 64,
Ce code fonctionnait parfaitement jusqu'à maintenant, et il fonctionne sur mon autre ordinateur, mais maintenant il bloque, j'ai une erreur WSH:
Ligne 25 car 2
Erreur 0x800700C1
Il s'agit de :shell.Run tempFolder & "\" & tempName & ".hta", 1, True

Pourriez-vous m'aider, merci

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
Function BrowseForFile()
 Dim shell : Set shell = CreateObject("WScript.Shell")
 Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
 Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
 Dim tempName : tempName = fso.GetTempName()
 Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
 tempFile.Write _
 "<html>" & _
 "    <head>" & _
 "        <title>Browse</title>" & _
 "    </head>" & _
 "    <body>" & _
 "        <input type='file' id='f'>" & _
 "        <script type='text/javascript'>" & _
 "            var f = document.getElementById('f');" & _
 "            f.click();" & _
 "            var shell = new ActiveXObject('WScript.Shell');" & _
 "            shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp', f.value);" & _
 "            window.close();" & _
 "        </script>" & _
 "    </body>" & _
 "</html>"
 tempFile.Close
 
 shell.Run tempFolder & "\" & tempName & ".hta", 1, True
 
 BrowseForFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
 shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
End Function
 
MsgBox BrowseForFile,64,"BrowseForFile"

**Cthulhu88** · 25/11/2013, 12h21

Bonjour,

Essayez comme suit :

Code :

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

oshell.Run tempFolder & "\" & tempName & ".hta", 1, True

Cordialement

Cthulhu88

**Superpat9999** · 25/11/2013, 12h32

Envoyé par Cthulhu88

Bonjour,

Essayez comme suit :

Code :

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

oshell.Run tempFolder & "\" & tempName & ".hta", 1, True

Cordialement

Cthulhu88

Merci pour la réponse, mais le problème reste identique

**hackoofr** · 25/11/2013, 13h25

vérifier si ton UAC est activé ou non, ou bien si ton antivirus qui bloque quelque chose

Essaies ce code :

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
Option Explicit
Dim Title
Title = "Browse for file optimized by Hackoo"
MsgBox BrowseForFile(),64,Title
Function BrowseForFile()
 Dim shell : Set shell = CreateObject("WScript.Shell")
 Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
 Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
 Dim tempName : tempName = fso.GetTempName()
 Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
 tempFile.Write _
 "<html>" & _
 "    <head>" & _
 "        <title>Browse</title>" & _
 "    </head>" & _
 "    <body>" & _
 "        <input type='file' id='f'>" & _
 "        <script type='text/javascript'>" & _
 "            var f = document.getElementById('f');" & _
 "            f.click();" & _
 "            var shell = new ActiveXObject('WScript.Shell');" & _
 "            shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp" & tempName & _
 "', f.value);" & _
 "            window.close();" & _
 "        </script>" & _
 "    </body>" & _
 "</html>"
 tempFile.Close
 shell.Run tempFolder & "\" & tempName & ".hta",0,True
 BrowseForFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp" & tempName)
 shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp" & tempName
 fso.DeleteFile(tempFolder & "\" & tempName & ".hta")
 End Function

**Superpat9999** · 25/11/2013, 19h01

Merci hackoofr,
Pour le moment je suis sur mon autre ordinateur, tous les codes fonctionnent !
Je vérifie tout demain sur le Windows 64.
Bonne soirée

**Superpat9999** · 26/11/2013, 12h47

Bonjour,

UAC était désactivé et Kaspersky désactivé, aucun changement.

Curieusement la code ne fonctionne pas sur l'ordi avec Windows 64, j'ai trouvé 2 codes fonctionnant, je les joints.

Je ne sais pas pourquoi, mais ils fonctionnent.

Bonne journée

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
38
39
40
41
42
43
44
45
Option Explicit
 
Dim strFile
 
strFile = SelectFile( )
 
If strFile = "" Then
    WScript.Echo "No file selected."
Else
    WScript.Echo """" & strFile & """"
End If
 
 
Function SelectFile( )
    ' File Browser via HTA
    ' Author:   Rudi Degrande, modifications by Denis St-Pierre and Rob van der Woude
    ' Features: Works in Windows Vista and up (Should also work in XP).
    '           Fairly fast.
    '           All native code/controls (No 3rd party DLL/ XP DLL).
    ' Caveats:  Cannot define default starting folder.
    '           Uses last folder used with MSHTA.EXE stored in Binary in [HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ComDlg32].
    '           Dialog title says "Choose file to upload".
    ' Source:   http://social.technet.microsoft.com/Forums/scriptcenter/en-US/a3b358e8-15&ælig;-4ba3-bca5-ec349df65ef6
 
    Dim objExec, strMSHTA, wshShell
 
    SelectFile = ""
 
    ' For use in HTAs as well as "plain" VBScript:
    strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
             & "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
             & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
    ' For use in "plain" VBScript only:
    ' strMSHTA = "mshta.exe ""about:<input type=file id=FILE>" _
    '          & "<script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
    '          & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>"""
 
    Set wshShell = CreateObject( "WScript.Shell" )
    Set objExec = wshShell.Exec( strMSHTA )
 
    SelectFile = objExec.StdOut.ReadLine( )
 
    Set objExec = Nothing
    Set wshShell = Nothing
End Function

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
Option Explicit
 
WScript.Echo "Selected file: " & ChooseFile( )
 
 
Function ChooseFile( )
' Select File dialog based on a script by Mayayana
' Known issues:
' * Tree view always opens Desktop folder
' * In Win7/IE8 only the file NAME is returned correctly, the path returned will always be C:\fakepath\
' * If a shortcut to a file is selected, the name of that FILE will be returned, not the shortcut's
   ' On Error Resume Next
    Dim objIE, strSelected
    ChooseFile = ""
    Set objIE = CreateObject( "InternetExplorer.Application" )
    objIE.visible = False
    objIE.Navigate( "about:blank" )
    Do Until objIE.ReadyState = 4
    Loop
    objIE.Document.Write "<HTML><BODY><INPUT ID=""FileSelect"" NAME=""FileSelect"" TYPE=""file""><BODY></HTML>"
    With objIE.Document.all.FileSelect
        .focus
        .click
        strSelected = .value
    End With
    objIE.Quit
    Set objIE = Nothing
    ChooseFile = strSelected
End Function

**Superpat9999** · 26/11/2013, 14h53

Attention le second code retourne un mauvais dossier le premier est parfait

Code vbs ne fonctionnant plus

VBScript

Discussions similaires

Partager

Partager