Visual Basic Script

[Spock]

Boas...

Ando a fazer um script no trabalho para colocar uns ficheiros *.bak (backups) em um ficheiro Zip consoante o nome, isto é:

Se o ficheiro se chamar BD_XXXX_YYYY_Backup_2009010004040

Retiro o nome: BD_XXXX_YYYY_Backup

o ano: 2009 (4 primeiros numeros)

e mês: 01 (2 numeros seguintes)

logo este ficheiro tem de ir para o Zip:

BD_XXXX_YYYY_Backup.2009.01.Zip

Para tal percorre dois niveis...

Pasta Teste,

      Pasta 1 (Que possui os tais ficheiros)

      Pasta 2 (Que possui mais dos tais ficheiros)

      Pasta 3 (Que possui ainda mais dos tais ficheiros)

      ...

vbscript version 5.7.0.5730 (WINDOWS SERVER 2003)

vbscript version 5.7.0.18069 (WINDOWS VISTA)

vbscript version 5.7.0.18066 (WINDOWS XP)

Já testei em Windows XP(versão do VBScript.dll -> 5.7.0.18066) e em Windows Vista (Vbscript.dll -> 5.7.0.18069).

Em Windows Server 2003(Vbscript -> 5.7.0.5730) que é onde preciso de correr, dá me erro (Windows Script Host 800A004C) Que é "path not found".

Aqui segue o código:

'Final.vbs 

Dim objFSO, objFolder, objFile, objSubFolders, file
Dim strDirectoy 
Dim fileName, fileYear, fileMonth 
Dim zipFileName

strDirectory = "\Teste\" 

set objFSO = CreateObject("Scripting.FileSystemObject") 

set objFolder = objFSO.getFolder(strDirectory)

set objSubFolders = objFolder.SubFolders

Call doIt(objFolder) 

Function doIt(objFolder) 
    For each folderIdx In objSubFolders
        set objFile = folderIdx.Files 
        For each fileIdx In objFile 
		If (StrComp(Right(fileIdx.Name,4),".txt")=0) then
			file = fileIdx.Name
			temp = InStr(fileIdx.Name,"backup")
			fileName = Left(fileIdx.Name,temp+5)
			fileYear = Mid(fileIdx.Name,temp+7,4)
			fileMonth = Mid(fileIdx.Name,temp+11,2)
			zipFileName = strDirectory&folderIdx.Name&"\"&fileName&"."&fileYear&"."&fileMonth&".zip"
			Set oShell = WScript.CreateObject("WScript.Shell")
			oShell.Run "winzip32 -m " & zipFileName & " " & file
		else
		'Não faz nada de propósito 				
		End If          
        Next 
    Next 
End Function

Alguém me consegue explicar porque funciona no XP e no Vista, e não no Windows Server 2003?!?! 

Tou farto de bater com a cabeça nas paredes e não percebo o porque.

Alguém me ajuda?! o que está a falhar?! o que preciso de fazer?!

Obrigado,

Spock

[Spock]

Boas...

Já resolvi a questão... a 1ª barra do "\teste\" estava a indicar ao servidor que era c:\Teste em vez da pasta seguinte ao ficheiro  😁

Agora precisava de saber outra coisa se possível...

Existe maneira de parar o programa até o Zip anterior ter acabado?! é que muitas vezes vários ficheiros *.bak estão a ser zippados ao mesmo tempo sobre o mesmo ficheiro zip e dá erro, pois o zip já está a ser utilizado e não se consegue guardar.

O meu problema é que tanto tenho ficheiros de 50mb como 2,5Gb...

Alguém me ajuda?!  :down:

Desde já agradeço,

Spock  🙂

[blueveia]

Boas,

Desculpa lá Spock mas é que a tua dúvida é de um nível Avançado, eu pessoalmente não consigo responder-te.

Encontrei foi este site que explica como criar, acrescentar, listar, fundir, .... ficheiros zip.

LINK:http://www.example-code.com/vbscript/zip.asp

INFO:Site em inglês-

DICA:Procuras o tópico que mais se adequa à tua dúvida e carregas.

Cumps^^

[YoungCoder]

Talvez queiras dar uma "vista-de-olhos" ou adaptar este script a teu gosto 😉

dim fso, vPath, oFolder, vFullPath, oSubFolder, vFile, vSource, vTarget, vDelFile
dim vLogPath, vLogFile, vFileCount, vSubject, vTo, vFrom
Const ForReading = 1, ForWriting = 2, ForAppending = 8

'set the path containing the folders & backup files to parse
vPath = "C:\Teste\"

'ZIP all backups created today & delete BAK files
'------------------------------------------------

set fso = CreateObject("Scripting.FileSystemObject")

set oFolder = fso.getfolder(vPath)
for each SubFolder in oFolder.SubFolders
if SubFolder.Name <> "master" and SubFolder.Name <> "model" and SubFolder.Name <> "msdb" then
	vFullPath = vPath & SubFolder.Name & "\"
	set oSubFolder = fso.getfolder(vFullPath)
	set oFiles = oSubFolder.Files
	for each oFile in oFiles
		if datevalue(oFile.DateLastModified) = datevalue(Date) and right(oFile.Name,3) = "bak" then
			vSource = vFullPath & oFile.Name
			vTarget = replace(vSource,".bak",".zip")
			vDelFile = 0
			vDelFile = Zip(vSource,vTarget)
			if vDelFile = 1 then
				oFile.Delete
			end if
		end if
	next
end if
next

'Log all files in appropriate backup folders & email to sql operators
'--------------------------------------------------------------------

vLogPath = "C:\Teste\"
vLogFile = "user_db_backup.log"
vSubject = "SERVER Backup Status - User DBs"
vTo = "Spock@portugal-a-programar.org"
vFrom = "backupScript@portugal-a-programar.org"

' Create the status file
Set oStatusFile = fso.OpenTextFile(vLogPath & vLogFile, ForWriting, True)
oStatusFile.WriteLine("Server Backup Status - User DBs - " & Date)
oStatusFile.WriteLine("=======================================================")
oStatusFile.WriteLine("")

for each SubFolder in oFolder.SubFolders
if SubFolder.Name <> "master" and SubFolder.Name <> "model" and SubFolder.Name <> "msdb" then
	vFullPath = vPath & SubFolder.Name & "\"
	oStatusFile.WriteLine(vFullPath)
	set oSubFolder = fso.getfolder(vFullPath)
	set oFiles = oSubFolder.Files
	vFileCount = 0
	for each oFile in oFiles
		oStatusFile.WriteLine("     " & oFile.Name)
		vFileCount = vFileCount + 1
	next
	if vFileCount = 0 then
		oStatusFile.WriteLine("     " & "*** NO FILES IN THIS FOLDER ***")
	end if
	oStatusFile.WriteLine("")
	oStatusFile.WriteLine("-------------------------------------------------------")
end if
next

oStatusFile.Close
Set oStatusFile = Nothing

SendStatus vSubject,vLogPath & vLogFile,vFrom,vTo

set oFiles = nothing
set oSubFolder = nothing
set oFolder = nothing
set fso = nothing

WScript.Quit


Function Zip(sFile,sArchiveName)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
  Set oShell = WScript.CreateObject("Wscript.Shell")

  '--------Find Working Directory--------
  aScriptFilename = Split(Wscript.ScriptFullName, "\")
  sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
  sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
  '--------------------------------------

  '-------Ensure we can find 7z.exe------
  If oFSO.FileExists(sWorkingDirectory & "\" & "7z.exe") Then
    s7zLocation = ""
  ElseIf oFSO.FileExists("C:\Program Files\7-Zip\7z.exe") Then			'for 32bit OS
    s7zLocation = "C:\Program Files\7-Zip\"								'for 32bit OS
'  ElseIf oFSO.FileExists("C:\Program Files (x86)\7-Zip\7z.exe") Then	'for 64bit OS
'    s7zLocation = "C:\Program Files (x86)\7-Zip\"						'for 64bit OS
  Else
'  Error: Couldn't find 7z.exe
    Zip = 0
    Exit Function
  End If
  '--------------------------------------

  oShell.Run """" & s7zLocation & "7z.exe"" a -tzip -y """ & sArchiveName & """ " _
  & sFile, 0, True   

  If oFSO.FileExists(sArchiveName) Then
    Zip = 1
  Else
'    Error: Archive Creation Failed.
    Zip = 0
  End If
End Function

'Send email notification with status file as body ofemail.
Function SendStatus(strSubject,strBodySource,strFrom,strTo)
Dim vSendFile, vBodyText, objMessage

Set vSendFile = fso.OpenTextFile(strBodySource,ForReading)
vBodyText = vSendFile.ReadAll
vSendFile.Close
Set vSendFile = Nothing

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = strSubject
objMessage.From = strFrom
objMessage.To = strTo
objMessage.TextBody = vBodyText

'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "MAINT70"
'Server port (typically 25)
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==

objMessage.Send

set objMessage = Nothing

End Function