taglia pdf - vbs

'

Option explicit

'

' vbs - drag and drop

' utilizza Ghostscript per ritagliare una parte di un file pdf.

'

' FORMAT_A4 PDF = 595.28 841.89

'

Dim objA

Set objA = Wscript.Arguments

if objA.count = 0 Then

Wscript.Echo "Serve almeno 1 file pdf " ' verifica che ci siano argomenti

Wscript.Quit

End If

'

Dim objFSO

Set objFSO = CreateObject("Scripting.FileSystemObject")

dim quantifile, contali, nomefile, filepdf, suffisso, nomefilepdf

'

quantifile = objA.count - 1

' ricerca file pdf passatti come argomenti

for contali = 0 to quantifile

nomefile = trim(obja(contali))

suffisso = lcase(objFSO.GetExtensionName(nomefile))

if suffisso = "pdf" then

filepdf = nomefile

nomefilepdf = objFSO.GetFileName(nomefile)

call croppdf(filepdf, nomefilepdf)

end if

next

'

sub croppdf(filedatagliare, pnomefilepdf)

'

Dim wsh, esegui, attesa

Set wsh = CreateObject("WScript.Shell")

'

esegui = ""

esegui = esegui & "C:\Programmi\gs\gs8.64\bin\gswin32 -sDEVICE=pdfwrite -o "

esegui = esegui & " C:\pdf\" & pnomefilepdf

' [da sinistra] [dal basso] [da destra ] [dall alto]

esegui = esegui & " -c ""[/CropBox [0 610 595 841 ] /PAGES pdfmark"" -f "

esegui = esegui & filedatagliare

attesa = wsh.Run (esegui, 1, true) '



'

end sub

' ====

unisci Fdf a Pdf - vbs

'

'

' vbs - unisce i valori contenuti in un file Fdf

' nel file Pdf editabile contenente i relativi campi.

'

Option explicit

'

Dim objA

Set objA = Wscript.Arguments

if objA.count = 0 Then

Wscript.Echo "Servono almeno due file: uno pdf e uno fdf"

Wscript.Quit

End If

'

Dim objFSO

Set objFSO = CreateObject("Scripting.FileSystemObject")

'

dim quantifile, contali, nomefile, filepdf, suffisso

quantifile = objA.count - 1

' ricerca il file pdf

for contali = 0 to quantifile

nomefile = trim(obja(contali))

suffisso = lcase(objFSO.GetExtensionName(nomefile))

if suffisso = "pdf" then

filepdf = nomefile

end if

next

'

' ricerca i fle fdf

for contali = 0 to quantifile

nomefile = trim(obja(contali))

suffisso = lcase(objFSO.GetExtensionName(nomefile))

if suffisso = "fdf" then

call stampapdf(nomefile) ' stampa i file unisce fdf a pdf

call muovifile(nomefile) ' il file pdf generato assume il nome del file fdf

end if

next

'

' ===

sub muovifile(pnomefile)

Dim objFSO, origine, destinazione

Set objFSO = CreateObject("Scripting.FileSystemObject")

'

origine = "C:\pdf\770ED.pdf" ' file Pdf con i campi da compilare

destinazione = "C:\pdf\" & objFSO.GetBaseName(pnomefile) & ".pdf" ' nome file Fdf senza suffisso

'

objFSO.MoveFile origine, destinazione



end sub

' =====

sub stampapdf(strPDFpath)

'

Dim objPrinter, stampantepredefinita

Set objPrinter = CreateObject("WScript.Network")

objPrinter.SetDefaultPrinter "PDFCreator" ' assegna la stampante pdf come predefinita

'

Dim wsh, esegui, attesa

Set wsh = CreateObject("WScript.Shell")

'

'esegui = "acrord32.exe /p /h """ & strPDFpath

esegui = "acrord32.exe /t /h """ & strPDFpath

'attesa = wsh.Run (esegui, 1, true) ' nel caso si voglia chiudere manualmente il file pdf

wsh.Run esegui

'

WScript.Sleep 15000 ' attende 15 secondi prima di terminare Adobe

'

objPrinter.SetDefaultPrinter "AMMINISTRA" ' ripristina la stampante predefinita

'

dim strComputer, objWMIService, colProcessList, objProcess

strComputer = "."

Set objWMIService = GetObject ("winmgmts:\\" & strComputer & "\root\cimv2")

Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'acrord32.exe'")

For Each objProcess in colProcessList

objProcess.Terminate()

Next

'

end sub

' =================

P

'

' vbs - Microsoft Outlook Exchange 2000

' elenca tutte le cartelle pubbliche

'

'

Option Explicit

'

dim NomeArchivio, cosascrivere

NomeArchivio="C:\elenco-cartelle-exchange.txt" '

'

call cancellazioneiniziale(NomeArchivio)

'

call ElencaCartellePubbliche

' ===============

sub ElencaCartellePubbliche()

Dim objFolder, objNamespace, objOutlook

'

Const TipoCartella = 18 ' cartelle pubbliche ' 5 = Sent Items

'

Set objOutlook = CreateObject( "Outlook.Application" )

Set objNamespace = objOutlook.GetNamespace( "MAPI" )

'

objNamespace.Logon "Default Outlook Profile", , False, False

Set objFolder = objNamespace.GetDefaultFolder( TipoCartella )

'

Dim scartelle

'

for each scartelle in objFolder.folders

'msgbox scartelle.Name

cosascrivere = scartelle.Name

Call ScriviFileJollyAppend(NomeArchivio, cosascrivere)

next

'

Set objOutlook = Nothing

Set objNamespace = Nothing

Set objFolder = Nothing

'

End sub

' =====

Sub ScriviFileJollyAppend(pNomeArchivio, pcosascrivere)

dim fso, rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(pNomeArchivio)) Then

'msg = filespec & " esiste."

Set rifefile = fso.OpenTextFile(pNomeArchivio, 8)

Else

'msg = filespec & " Non esiste."

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

End If

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

' ===

sub cancellazioneiniziale(vNomeArchivio)

dim CFSO

Set CFSO = CreateObject("Scripting.FileSystemObject")

If CFSO.FileExists(vNomeArchivio) = true Then

CFSO.DeleteFile(vNomeArchivio)

else

end if

end sub

'=========