[Resolvido] Criar Ficheiro .zip com data actual

[ferreira12 0]

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?

Editado 1 de Março de 2013 por thoga31
GeSHi

[bioshock 169]

Talvez isto?

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

[ferreira12 0]

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.

[bioshock 169]

Percebi mal o que querias.

http://stackoverflow.com/questions/906354/how-to-zip-files-in-vb-net-2005

http://dotnetzip.codeplex.com/

[acao 21]

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

Editado 3 de Março de 2013 por acao

[ferreira12 0]

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

[acao 21]

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

[ferreira12 0]

Já consegui resolver o problema. Obrigado a todos uma vez mais

[ferreira12 0]

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

Editado 4 de Março de 2013 por ferreira12

[acao 21]

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

Editado 5 de Março de 2013 por acao

[ferreira12 0]

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.