ferreira12 Posted March 1, 2013 at 04:52 PM Report #497549 Posted March 1, 2013 at 04:52 PM (edited) 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 March 1, 2013 at 08:25 PM by thoga31 GeSHi
bioshock Posted March 2, 2013 at 10:46 PM Report #497675 Posted March 2, 2013 at 10:46 PM Talvez isto? Dim arquivo As Folder = sc.Namespace("C:\TESTE[" + Datetime.Now + "].zip")
ferreira12 Posted March 3, 2013 at 02:02 PM Author Report #497739 Posted March 3, 2013 at 02:02 PM 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 Posted March 3, 2013 at 02:37 PM Report #497745 Posted March 3, 2013 at 02:37 PM Percebi mal o que querias. http://stackoverflow.com/questions/906354/how-to-zip-files-in-vb-net-2005 http://dotnetzip.codeplex.com/
acao Posted March 3, 2013 at 10:09 PM Report #497796 Posted March 3, 2013 at 10:09 PM (edited) 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 March 3, 2013 at 10:11 PM by acao
ferreira12 Posted March 4, 2013 at 12:26 PM Author Report #497835 Posted March 4, 2013 at 12:26 PM 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 Posted March 4, 2013 at 03:34 PM Report #497854 Posted March 4, 2013 at 03:34 PM 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 Posted March 4, 2013 at 06:06 PM Author Report #497876 Posted March 4, 2013 at 06:06 PM Já consegui resolver o problema. Obrigado a todos uma vez mais
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now