mercoledì 4 gennaio 2017

crea archivio digitale 2017 - vbs

' trasferito

option explicit

'

dim cartelladacansionare

cartelladacansionare = "C:\ARCHIVIO_DIGITALE_2016\"

'

dim cartelladestinazione, nomecartella, scartella

cartelladestinazione = "C:\ARCHIVIO_DIGITALE_2017\"

'

dim tipofile, ltipo, ifile, sfile

tipofile = "txt"

'

dim dblog, slog

dblog = "C:\azioniprogrammate\archivio-digitale-crea\temp-report-file.txt"

'

dim objFSO, objSuperFolder

'

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objSuperFolder = objFSO.GetFolder(cartelladacansionare)



Call ShowSubfolders (cartelladacansionare)

'

'

'

Sub ShowSubFolders(fFolder)

'

dim objFolder, colFiles, objFile

For Each objFolder In objFSO.GetFolder(fFolder).SubFolders

slog = "1: " & objFolder.Path

'call ScriviFileJollyAppend(dblog, slog)

'

nomecartella = objFolder.name

scartella = cartelladestinazione & nomecartella & "\"

'

call esistecartella(scartella, "crea")

'

Set colFiles = objFolder.Files

For Each objFile in colFiles

ltipo = UCase(objFSO.GetExtensionName(objFile.name))

If ltipo = ucase(tipofile) Then

ifile = cartelladacansionare & nomecartella & "\" & objFile.Name

sfile = scartella & objFile.Name

call esistefile(sfile, "copia")

else

if ltipo = "PDF" then

else

end if

End If

Next

'

Next

'

'

End Sub

'

' ====

'

sub esistefile(pfile, pazione)

'

'

If (objFSO.FileExists(pfile)) = true Then

' esiste!

Else

if pazione = "copia" then

objFSO.CopyFile ifile, scartella, true

end if

End If

'

'

end sub

'

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

'

sub esistecartella(strParentPath, pazione)

'

dim newFolder

'

If objFSO.FolderExists(strParentPath) = False Then

if pazione = "crea" then

Set newFolder = objFSO.CreateFolder(strParentPath)

end if

End If

'

'

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

'

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

'

1 commento:

  1. Ciao,
    ho scoperto oggi il tuo sito, complimenti.
    Ti segnalo il mio, che è questo http://emanuelemattei.blogspot.it/ .
    Buona programmazione

    RispondiElimina