Option Explicit
Dim oFSO,oDrive,sFileName,nFileTrovati,coll
Sub Main
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oFolder
Dim nCopiati,sFileDest,sDirDest,sDirInput,n,bTaglia,sFile ,bProsegui , bSaltaSeEsiste
Set coll = GetNewCollection
sDirInput = "C:\Users\luigi\AppData\Roaming\spaziometria\Script\"
sDirDest = "e:\temp\"
bTaglia = False
bSaltaSeEsiste = False ' se false quando il file di destinazione esiste lo copia e aggiunge un numero al nome file , se impostato true i lfile viene saltato
Set oFolder = oFSO.GetFolder(sDirInput)
Call Recurse(oFolder)
Set oFSO = Nothing
If coll.count > 0 Then
If bTaglia Then
If MsgBox("Eseguo lo SPOSTAMENTO di " & coll.count & " file da " & vbCrLf & sDirInput & vbCrLf & "Verso" & vbCrLf & sDirDest & " ?",vbQuestion + vbYesNo) = vbYes Then
bProsegui = True
End If
Else
If MsgBox("Eseguo la COPIA di " & coll.count & " file da " & vbCrLf & sDirInput & vbCrLf & "Verso" & vbCrLf & sDirDest & " ?",vbQuestion + vbYesNo) = vbYes Then
bProsegui = True
End If
End If
If bProsegui Then
For Each sFile In coll
n = 0
sFileDest = sDirDest & GetNomeFile(sFile)
If FileEsistente(sFileDest) = False Then
Call CopiaFile(sFile,sFileDest)
nCopiati = nCopiati + 1
If bTaglia Then EliminaFile(sFile)
Messaggio "Copia in corso ..." & nCopiati
Else
If bSaltaSeEsiste = False Then
Do While FileEsistente(sFileDest)
n = n + 1
sFileDest = sDirDest & GetNomeFile(sFile) & "." & n & ".ls"
Loop
Call CopiaFile(sFile,sFileDest)
nCopiati = nCopiati + 1
If bTaglia Then EliminaFile(sFile)
Messaggio "Copia in corso ..." & nCopiati
End If
End If
If ScriptInterrotto Then Exit Sub
Next
End If
End If
Set oFSO = Nothing
Set oFolder = Nothing
Set coll = Nothing
End Sub
Function GetNomeFile(sFile)
Dim av
av = Split(sFile,"\")
GetNomeFile = av(UBound(av))
End Function
Sub Recurse(oFolder)
Dim oSubFolder,oFile
If ScriptInterrotto Then Exit Sub
If IsAccessible(oFolder) Then
For Each oSubFolder In oFolder.SubFolders
Recurse oSubFolder
Next
For Each oFile In oFolder.Files
If Right(oFile.Name,3) = ".ls" Then
nFileTrovati = nFileTrovati + 1
Messaggio("file trovati :" & nFileTrovati)
coll.Add oFile.path
End If
Next
End If
End Sub
Function IsAccessible(oFolder)
On Error Resume Next
IsAccessible = oFolder.SubFolders.Count >= 0
End Function