' 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
'
' ======================
'
