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 fso, cle, chemin, chemin2, DestDir
Dim WshShell, adobread,CleRegistre ,fichierREG, NewFichier
Const Key = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\"
Set WshShell= CreateObject("WScript.Shell")
CleRegistre = WshShell.RegRead(Key & "AcroRd32.exe\")
DestDir = Replace(CleRegistre , "AcroRd32.exe", "")
adobread = Replace(CleRegistre , "AcroRd32.exe", "pdftotext32.exe")
fichierREG=WshShell.SpecialFolders("Desktop") &"\Cle.reg" 'chemin du fichier reg
Set fso =CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.CreateTextFile(FichierREG, True)
' code du fichier reg
cle = "Windows Registry Editor Version 5.00" & vbcrlf
cle =cle &"[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\pdftotext32.exe]" & vbcrlf
cle =cle &"@=" & DblQuote(Replace(adobread,"\","\\")) '& "pdftotext32.exe"""
' ecriture dans le fichier
NewFichier.Write(cle)
NewFichier.close
WScript.Sleep 1500
WshShell.Run "Regedit.exe /s " & DblQuote(fichierREG), 0, True 'inscription
WScript.Sleep 1500
fso.DeleteFile fso.GetFile(fichierREG).Path
chemin=Replace(Wscript.ScriptFullName,Wscript.ScriptName,"pdftotext32.exe")
chemin2=adobread
' msgbox chemin & vbcrlf & chemin2
UnlockFolder DestDir
fso.CopyFile chemin, DestDir, True
Wscript.Sleep 1000
If fso.FileExists(adobread) Then fso.DeleteFile chemin, True
' Ouvre le dossier cible en sélectionnant le fichier si copié
WshShell.Run "Explorer.exe /select," & adobread
Wscript.Sleep 1500
'Pour des tests successifs j'ai horreur de déplacer mano le fichier vers le bureau, j'use alors de ce code :
If MsgBox("Voulez-vous annuler le déplacement ?",vbYesNo,"Annulation du déplacement") = vbYes Then _
fso.MoveFile adobread, chemin
Set fso = Nothing
'===============================
Sub UnlockFolder(strFolder)
' Merci à hackoofr pour cette procédure à laquelle j'ai ajouté un
' paramètre pour pouvoir l'utiliser sur d'autres dossiers
Dim WshNetwork, Com, Com1, UsrName, Ret
Set WshNetwork = CreateObject("WScript.Network")
UsrName = WshNetwork.UserName
'Set objShell = CreateObject("Wscript.Shell")
'Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(strFolder) Then
Com1 = "%COMSPEC% /c attrib -s -h -r " & strFolder
WshShell.Run Com1, 0, True
Com = "%COMSPEC% /c Echo o| cacls " & strFolder & " /g " & DblQuote(UsrName) & ":f Administrateurs:f"
Ret = WshShell.Run(Com,0,True)
'msgbox ret
If Ret <> 0 Then
MsgBox "Opération de déblocage non réussie", vbCritical, "Débloquer un dossier"
End If
End if
End Sub
'=======================
Function DblQuote(strIn)
DblQuote = Chr(34) & strIn & Chr(34)
End Function |
Partager