vbs elenca tutte le sottocartelle di una directory crea un file pdf unico

'

option explicit

'

' vbs elenca tutte le sottocartelle di una directory.

' se nella sottocartella esiste una directory con un determinato nome

' scrive elenco dei file Pdf presenti e li raggruppa in un unico file.

dim cartella

cartella = "C:\azioniprogrammate\fornitori-note-accredito-tutte\"

'

dim dbcartelladascansionare, cartelladascansionare, dovearchiviare

'

dbcartelladascansionare = cartella & "db-cartella-da-scansionare.txt"

'

cartelladascansionare = leggiparametritogli(dbcartelladascansionare)

dovearchiviare = cartella & "elenco-cartelle.txt"

call cancellafile(dovearchiviare)

'

dim dblog, slog

dblog = cartella & "elencofatture.csv"

call cancellafile(dblog)

'

dim rtipofile

rtipofile = "pdf"

'

call ShowSubFolders(cartelladascansionare)

'

call leggifile(dovearchiviare)

'

call uniscipdf(cartella)

' =======

' ====

'

Sub ShowSubFolders(pcartelladascansionare)

dim folder, Subfolder, FSO

Set FSO = CreateObject("Scripting.FileSystemObject")

set folder = FSO.GetFolder(pcartelladascansionare)

For Each Subfolder in Folder.SubFolders

    call ScriviFileJollyAppend(dovearchiviare, Subfolder.Path)

   'ShowSubFolders Subfolder

 Next

End Sub

' ==========

' ===

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

sub leggifile(pfile)

dim objFSO, objFile, strLine, scartella, msg

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(pfile, 1)

Do While objFile.AtEndOfStream = False

    strLine = objFile.ReadLine

    scartella = strline & "\NA\"

    If (objFSO.FolderExists(scartella)) = true Then

        msg = scartella & " esiste."

        call elencafile(scartella)

    Else

        msg = scartella & " NON Esiste."

    End If

 

Loop

end sub

'

' === unisce in un unico file pdf i vari file.

'

sub uniscipdf(cartellainlettura)

dim azione, elencofilepdf, archiviofatturetutte

elencofilepdf  = cartellainlettura &  "elencofatture.csv"

archiviofatturetutte  = cartellainlettura &  "FattureTutte.pdf"

'

' utilizza la libreria java Pdfsam scaricabile dal sito Sourceforge.

azione = ""

azione = azione & "java -jar C:\Pubblica\pdfsam\lib\pdfsam-console-0.5.2.jar -l "

azione = azione & elencofilepdf 

azione = azione & " -overwrite -o "

azione = azione & archiviofatturetutte

azione = azione & " concat"

'

dim attesa, WshShell

set WshShell = CreateObject("WScript.Shell")

WshShell.CurrentDirectory = cartellainlettura

attesa = WshShell.Run (azione, 1, True)

'

end sub

' ===

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

'

sub elencafile(objStartFolder)

dim objFSO, objFolder, colFiles, objFile, sfile, stipo

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(objStartFolder)

Set colFiles = objFolder.Files

'

For Each objFile in colFiles

    sfile = objStartFolder & objFile.Name

    stipo = objFSO.GetExtensionName(sfile)

    if lcase(stipo) = lcase(rtipofile) then

       call ScriviFileJollyAppend(dblog, sfile & ",")

    end if

Next

'

'

end sub

' =====

' === legge parametri ==

' =======

function leggiparametritogli(sFilePathAndName)

dim sFileContents, oFS, oTextStream

Set oFS = CreateObject("Scripting.FileSystemObject")

If oFS.FileExists(sFilePathAndName) = True Then

     Set oTextStream = oFS.OpenTextFile(sFilePathAndName,1)

     sFileContents = trim(oTextStream.ReadAll)

     oTextStream.Close

     Set oTextStream = nothing

else

     sFileContents = ""

End if

Set oFS = nothing

sFileContents = replace(sFileContents, vbcrlf, "")

sFileContents = replace(sFileContents, vbcr, "")

sFileContents = replace(sFileContents, vblf, "")

leggiparametritogli = sFileContents

'

'

end function

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

' === sovra scrive file ====

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

Sub SovraScriviFile(pNomeArchivio, pcosascrivere)

dim fso,  rifefile

Set fso=CreateObject("Scripting.FileSystemObject")

Set rifefile = fso.CreateTextFile(pNomeArchivio, TRUE)

rifefile.WriteLine(pcosascrivere)

rifefile.Close

set rifefile = Nothing

End Sub

' =======

' === cancella file =======

' ========

sub cancellafile(pfile)

dim fs

Set fs=CreateObject("Scripting.FileSystemObject")

if fs.FileExists(pfile) then

   fs.DeleteFile(pfile)

end if

set fs=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

'

' =========

'