Jump to content
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

ferreira12

[Resolvido] Criar Ficheiro .zip com data actual

Recommended Posts

ferreira12

Boas,

Estou a tentar criar um backup de uma pasta todos os dias. Para isso estou a zipar a pasta. não estou é a conseguir colocar a data actual. deixo o codigo abaixo

Dim _sbuffer As Byte() = {80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
       FileIO.FileSystem.WriteAllBytes("C:\TESTE.zip" + System.DateTime.Now, _sbuffer, False)
       Dim sc As New Shell32.Shell
       Dim _pasta As Shell32.Folder = sc.NameSpace("C:\TESTE")
       Dim _arquivo As Shell32.Folder = sc.NameSpace("C:\TESTE.zip" + System.DateTime.Now)
       _arquivo.CopyHere(_pasta.Items, 4)

com este codigo só consigo criar o zip se ele encontrar o nome do zip igual. Como faria para ele criar uma pasta antes com a data actual?

Edited by thoga31
GeSHi

Share this post


Link to post
Share on other sites
bioshock

Talvez isto?

Dim arquivo As Folder = sc.Namespace("C:\TESTE[" + Datetime.Now + "].zip")

Share this post


Link to post
Share on other sites
ferreira12

Não, porque ele não encontra a pasta com esse nome, primeiro teria que criar uma nova pasta com a data actual.

Só que eu não sei como faço para criar uma pasta.zip nova.

Share this post


Link to post
Share on other sites
acao

boas

veja se é isto que necessita, se descomentar a linha comentada ele zipa apenas o ficheiro indicados, assim zipa a pasta

Private Sub CommandButton1_Click()
Call ZipaFicheiro
End Sub
Public Sub ZipaFicheiro()
Dim strDate As String, DefPath As String
Dim oApp As Object
Dim FName, FileNameZip
Dim strPrefix As String
 On Error Resume Next
DefPath = "C:\Users\xxxx\Desktop\ziparxls" 'Local e pasta onde está o ficheiro
If Right(DefPath, 1) <> "\" Then
	DefPath = DefPath & "\"
End If

strDate = Format(Now, "dd-mmm-yy_h-mm-ss")
FileNameZip = DefPath & strDate & ".zip"
'strPrefix = "Combinar.xlsm" 'Nome do ficheiro + extensão
FName = DefPath & strPrefix
	On Error Resume Next
Call CriaNovoZip(FileNameZip)
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere FName
MsgBox "Criado com Sucesso em: " & FileNameZip
Set oApp = Nothing
  Exit Sub
End Sub

Public Sub CriaNovoZip(sPath)
Dim ofso, arrHex, sBin, i, Zip
On Error Resume Next
Set ofso = CreateObject("Scripting.FileSystemObject")
arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
			   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(arrHex)
	sBin = sBin & Chr(arrHex(i))
Next
On Error Resume Next
With ofso.CreateTextFile(sPath, True)
	.Write sBin
	.Close
End With
  Exit Sub
End Sub

cumps

acao

Edited by acao

Share this post


Link to post
Share on other sites
ferreira12

Boas acao,

Dá me erro nas seguintes partes de código

oApp.Namespace(FileNameZip).CopyHere FName ' erro no FName

erro: Method arguments must be enclosed in parentheses.

e depois aqui dá o mesmo erro.

.Write sBin ' erro sBin

Share this post


Link to post
Share on other sites
acao

boas

em vba funciona, não testei em vbnet mas era suposto funcionar.

elimina «& strPrefix

ficaria assim

FName = DefPath

talvez seja esse o erro, porque se a linha anterior estiver comentada a string strPrefix é vazia e pode ser esse o erro.

cumps

acao

Share this post


Link to post
Share on other sites
ferreira12

Peço desculpa, mas vou precisar novamente da vossa ajuda.

gerei um executável, e quando fui experimentar num outro PC, deu me este erro

75220mwmetezcfyuslir.jpg

Edited by ferreira12

Share this post


Link to post
Share on other sites
acao

boas

veja se no outro pc tem instalado a mesma versão da framework que tem no pc que dá.

edit:

como conseguiu, usou a libraria ou alterou o cod que enviei para net.

ainda não consegui copiar os ficheiros para dentro do zip, gera o zip fica sempre sem nada.

cumps

acao

Edited by acao

Share this post


Link to post
Share on other sites
ferreira12

Com o teu código não consegui. Consegui foi colocar o meu codigo que iniciei o topico a dar, só que como estou a usar shell32, da esse erro. Já tentei colocar na framework 4 e o problema continuou.

o VS está numa máquina windows 8 e a que quer executar está no windows 7, reparo é que o ficheiro shell32 no windows 8 é maior que o do windows 7.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.