Forumitbr.com.br

Código: Selecionar todos

' Backup de diretório e sub-diretórios compactados
' Não necessita nenhum software adicional pois utiliza o recurso ZIP nativo do Windows
' Retirado do fórum itbr.org
' Por Marcelo Leães - [email protected]

Option Explicit
Dim arrResult

' Edite os caminhos conforme necessidade, primeiro é ORIGEM, segundo é DESTINO
' Mantenha a função GetFormattedDate para que o arquivo de saída possua Data. Atenção para não remover aspas.

arrResult = ZipFolder( "C:\Dell\", "D:\Backup-compactado-" & GetFormattedDate & ".zip" )

' Descomente este campo para receber telas de confirmação ao concluir a tarefa
' Para modo automatizado por agendador de tarefas, manter comentado.

'If arrResult(0) = 0 Then
'	If arrResult(1) = 1 Then
'		WScript.Echo "Sucesso!!! 1 diretorio vazio foi ignorado."
'	Else
'		WScript.Echo "Sucesso!!! " & arrResult(1) & " diretorios vazios foram ignorados"
'	End If
'Else
'	WScript.Echo "ERRO: " & Join( arrResult, vbCrLf )
'End If

' Daqui em diante não altere mais nada no código do Script

Function GetFormattedDate

  Dim strDate,StrDay,StrMonth,StrYear
  strDate = CDate(Date)
  strDay = DatePart("d", strDate)
  strMonth = DatePart("m", strDate)
  strYear = DatePart("yyyy", strDate)
  
  If strDay < 10 Then
    strDay = "0" & strDay
  End If
  
  If strMonth < 10 Then
    strMonth = "0" & strMonth
	
  End If
  
  GetFormattedDate =  strDay & "-" & strMonth & "-" & strYear
  
End Function

Function ZipFolder( myFolder, myZipFile )

	Dim intSkipped, intSrcItems
	Dim objApp, objFolder, objFSO, objItem, objTxt
	Dim strSkipped

	Const ForWriting = 2

	intSkipped = 0

	If Right( myFolder, 1 ) <> "\" Then
		myFolder = myFolder & "\"
	End If

	On Error Resume Next

	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
	Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
	objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
	objTxt.Close
	Set objTxt = Nothing

	If Err Then
		ZipFolder = Array( Err.Number, Err.Source, Err.Description )
		Err.Clear
		On Error Goto 0
		Exit Function
	End If
	
	Set objApp = CreateObject( "Shell.Application" )

	For Each objItem in objApp.NameSpace( myFolder ).Items
		If objItem.IsFolder Then

			Set objFolder = objFSO.GetFolder( objItem.Path )
			If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
				intSkipped = intSkipped + 1
			Else
				objApp.NameSpace( myZipFile ).CopyHere objItem
			End If
		Else
			objApp.NameSpace( myZipFile ).CopyHere objItem
		End If
	Next

	Set objFolder = Nothing
	Set objFSO    = Nothing

	If Err Then
		ZipFolder = Array( Err.Number, Err.Source, Err.Description )
		Set objApp = Nothing
		Err.Clear
		On Error Goto 0
		Exit Function
	End If

	intSrcItems = objApp.NameSpace( myFolder  ).Items.Count
	Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems
		WScript.Sleep 200
	Loop
	Set objApp = Nothing

	If Err Then
		ZipFolder = Array( Err.Number, Err.Source, Err.Description )
		Err.Clear
		On Error Goto 0
		Exit Function
	End If

	On Error Goto 0

	If intSkipped = 0 Then
		strSkipped = ""
	Else
		strSkipped = "diretorios vazios ignorados"
	End If

	ZipFolder = Array( 0, intSkipped, strSkipped )
	
End Function

Código: Selecionar todos

forfiles -p "D:\" -s -d -15 -m *.zip -c "cmd /c del /a /f /q @path"

Código: Selecionar todos

Set oFileSys = WScript.CreateObject("Scripting.FileSystemObject")

sRoot = "D:\Caminho"			
today = Date
nMaxFileAge = 3		'Dias a manter

DeleteFiles(sRoot)

Function DeleteFiles(ByVal sFolder)

	Set oFolder = oFileSys.GetFolder(sFolder)
	Set aFiles = oFolder.Files
	Set aSubFolders = oFolder.SubFolders

	For Each file in aFiles
		dFileCreated = FormatDateTime(file.DateCreated, "2")
		If DateDiff("d", dFileCreated, today) > nMaxFileAge Then
			file.Delete(True)
		End If
	Next

	For Each folder in aSubFolders
		DeleteFiles(folder.Path)
	Next

End Function

Código: Selecionar todos

arrResult = ZipFolder("C:\temp", "C:\teste\Backup-compactado-" & GetFormattedDate & ".zip")