VBS - erreur incompréhensible

Version imprimable

07/02/2014, 09h39
Ashtez

VBS - erreur incompréhensible
Bonjour!
Alors, aujourd'hui je me suis éloigné du java et ai fait un peu de VBS.
Mais, avec ce code:
Code:

1 2 3 4 Dim fso Set fso = CreateObject("Scripting.FileSystemObject") fso.CopyFile "‪‪C:\Temp\test.txt", "‪C:\Temp\copie\", True
j'obtiens cette erreur:
http://imgur.com/6YCWd2r
Et pourtant tous les liens sont exactes.
Merci d'avance!

Il y a des caractères non valides dans les chemins source et destination (caractères unicode)
Code:

1 2 3 Dim fso Set fso = CreateObject("Scripting.FileSystemObject") fso.CopyFile "‪‪C:\Temp\test.txt", "‪C:\Temp\copie\", True
La solution est ce
Code:

1 2 3 Dim fso Set fso = CreateObject("Scripting.FileSystemObject") fso.CopyFile "C:\Temp\test.txt", "C:\Temp\copie\", True

07/02/2014, 10h28
Ashtez

:cry: Merci beaucoup!!

:salut:
Vérifiez bien aussi le type d'encodage, car peut-être c'est la cause de l'apparition de ces caractères bizarres :roll:
Voici une petite fonction avec une petite gestion d'erreurs :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Source = "C:\Temp\test.txt"
Destination = "C:\Temp\copie\"
Call Copier(Source,Destination)
 
Sub Copier(Source,Destination)
    On error resume next
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile Source,Destination,True
    If Err Then
        MsgBox Err.Description,16,"ERREUR DE COPIE !"
    Else
        MsgBox "Le fichier " & DblQuote(Source) & " a été bien copié dans " & VbCrLF &_
        DblQuote(Destination),64,"Copie effectuée avec succès !"
    end if
End Sub
 
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function

Déjà, merci pour cette gestion d'erreur!
Sinon, j'ai juste fait ça, c'est plus pratique:

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
Source = ""
SrcIncomp = "C:\Temp\"
Destination = "C:\Temp\copie\"
 
aCopier = InputBox("Entrez le type de fichiers à copier", "Type de fichier")
Source = "" & SrcIncomp & aCopier
 
Call Copier(Source,Destination)
 
Sub Copier(Source,Destination)
    On error resume next
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile Source,Destination,True
    If Err Then
        MsgBox Err.Description,16,"ERREUR DE COPIE !"
    Else
        MsgBox "Le fichier " & DblQuote(Source) & " a été bien copié dans " & VbCrLF &_
        DblQuote(Destination),64,"Copie effectuée avec succès !"
    end if
End Sub
 
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function

Et encore merci, j'ai envie de me facepalmer à cause de ces caractères...

:salut:
Voici une autre version qui remplace le inputbox par BrowseForFile :king:

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
Option Explicit
Dim Titre,Source,Destination,Question
Titre = "Copier les fichiers © Hackoo 2014"
Source = BrowseForFile()
Destination = "C:\Temp\copie\"
Question = MsgBox("Voulez-vous copier "& VbCrLF & DblQuote(Source) & VbCrLF &_
 "dans ce dossier " & DblQuote(Destination) & " ?" & VbCrLF & VbCrLF &_
 "Si Oui, alors cliquez sur [OUI]"& VbCrLF &_
 "Si non, alors cliquez sur [NON]",VBYesNO+VbQuestion,Titre)
 If Question = VbYes then
    Call Copier(Source,Destination)
 else
    WScript.Quit
 End if
'***************************************************************************************
Sub Copier(Source,Destination)
    On error resume next
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile Source,Destination,True
    If Err Then
        MsgBox Err.Description,16,"ERREUR DE COPIE !"
    Else
        MsgBox "Le fichier " & DblQuote(Source) & " a été bien copié dans ce dossier " & VbCrLF &_
        DblQuote(Destination),64, Titre +" ===> Copie effectuée avec succès "
    end if
End Sub
'***************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'***************************************************************************************
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
'***************************************************************************************