Il giorno Wed, 3 Mar 2021 11:36:34 -0000 (UTC), Ammammata
<
amma...@tiscalinet.it> ha scritto:
>Il giorno Wed 03 Mar 2021 11:06:27a, *SB* ha inviato su it.comp.aiuto il
>messaggio
news:sonu3gl7kgniv0ijg...@4ax.com. Vediamo cosa ha
>scritto:
>
>> Se ti interessa lo cerco.
>>
>
>se lo trovi vedo di adattarlo, grazie
Ecco qui, è roba di diversi anni fa, comunque se hai qulche quesito cerco di
aiutarti
Il programma usa CurDir, quindi andrebbe lanciato all'interno dell cartella con
i files.
Carica il testo tra le righe sotto in un editor e salvalo come PrintLast.vbs
___________________________________
'Programma per stampare l'ultima pagina di in file pdf in una PNG
Set Fso = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
CurDir = oShell.CurrentDirectory & "\"
ImPAth=(CurDir & "Images\")
If Fso.FolderExists(ImPAth)=False Then Fso.CreateFolder(ImPAth): WScript.Sleep
1000
Set objFolder = Fso.GetFolder(CurDir)
Set colFiles = objFolder.Files
Set Processes = GetObject("winmgmts:").InstancesOf("Win32_Process")
For Each Process In Processes
If StrComp(Process.Name, "FoxitReader.exe", vbTextCompare) = 0 Then
If Len(intProcessId) = 0 Then intProcessId = Process.ProcessId
'MsgBox Process.Name &" "&intProcessId
Exit For
End If
Next
For Each objFile in colFiles
Np = objFile.Path 'nome completo
If (LCase(Fso.GetExtensionName(Np)) = "pdf") And InStr(Np,"Atto")>0
Then
Nam = ImPAth & Fso.GetBaseName(Np)
Namp = Nam & ".png"
If Fso.FileExists(Namp)= False Then
oShell.Run Chr(34) & Np & Chr(34) ,0 ,False
Text2Clip Nam
Call PrintLast
X=100
Do: If Fso.FileExists(Namp)= True Then Exit Do
Wscript.Sleep 300
If x=0 Then MsgBox Namp & vbcrlf & "UNFOUND":
WScript.Quit
X=X-1
Loop
End If
End If
Next
WScript.Quit
Sub PrintLast
Wscript.Sleep 300
oShell.AppActivate intProcessId : WScript.Sleep 200
' Cmd = NirCmd & " win activate etitle " & Chr(34) & "eader" & Chr(34):
oShell.Run Cmd ,0, True
oShell.SendKeys "^{END}" 'conferma
WScript.Sleep 200
oShell.SendKeys "^p"
WScript.Sleep 200
oShell.SendKeys "{TAB}" :WScript.Sleep 100
oShell.SendKeys "{TAB}" :WScript.Sleep 100
oShell.SendKeys "{TAB}" :WScript.Sleep 100
oShell.SendKeys "{TAB}" :WScript.Sleep 100
oShell.SendKeys "{TAB}" :WScript.Sleep 100
oShell.SendKeys "{UP}" :WScript.Sleep 100
oShell.SendKeys "{ENTER}" 'conferma
Wscript.Sleep 1500
oShell.SendKeys "^a" :WScript.Sleep 200'NOME FILE
oShell.SendKeys "^v" 'NOME FILE
WScript.Sleep 800
Dly = 300
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{DOWN}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{TAB}" :WScript.Sleep Dly
oShell.SendKeys "{ENTER}" 'conferma
Wscript.Sleep 1000
oShell.AppActivate intProcessId : WScript.Sleep 200
oShell.SendKeys "^{F4}" :WScript.Sleep 1000'NOME FILE
End Sub
Sub Text2Clip(Txt)
' Set Fso = CreateObject("Scripting.FileSystemObject")
DirWinSys = Fso.GetSpecialFolder(1)
ClpB = DirWinSys & "\clip.exe"
If Fso.FileExists(ClpB)Then
' ForceCScript()
Set objShell= CreateObject("WScript.Shell")
Set oExec = objShell.Exec(ClpB)
Set oIn = oExec.stdIn
WScript.Sleep 20
oIn.WriteLine Txt
WScript.Sleep 10
oIn.Close
End If
End Sub
_______________________________
--
ciao
Stefano