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