Notifications
Clear all

Zipar arquivos via VBA

5 Posts
3 Usuários
0 Reactions
4,669 Visualizações
(@douglaslm)
Posts: 12
Eminent Member
Topic starter
 

Pessoal:

Alguém possui um código para zipar arquivos em excel, PDF e WORD, onde ao salvar todos esses arquivos em um somente se possa renomear o arquivo ZIP com nomes e datas.

Att;

 
Postado : 28/01/2014 12:20 pm
(@gtsalikis)
Posts: 2373
Noble Member
 

somente se possa renomear o arquivo ZIP com nomes e datas.

Hein? existe esse tipo de mágica? Se existir, vou ficar de olho no tópico...

 
Postado : 28/01/2014 12:51 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Pessoal:

Alguém possui um código para zipar arquivos em excel, PDF e WORD, onde ao salvar todos esses arquivos em um somente se possa renomear o arquivo ZIP com nomes e datas.

Att;

Douglas ficou bem esquisita esta questão, eu não entendi o que pretende :
Alguém possui um código para zipar arquivos em excel :
R: Para compactar o arquivo, com o WinZip pode usar este :
Zipar planilha... - http://social.msdn.microsoft.com/Forums ... um=excelpt
Se utilizar o WinRar, altere estas linhas:
'PathWinZip = "C:program fileswinzip"
PathWinZip = "C:Arquivos de programasWinRAR"

e esta:
'Zip the file
ShellStr = PathWinZip & "Winzip32 -min -a" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
ShellAndWait ShellStr, vbHide

por esta :
'Zip the file
ShellStr = PathWinZip & "WinRAR a" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
ShellAndWait ShellStr, vbHide

Quanto a questão de Renomear, você pode estar utilizando uma rotina especifica para isto.

Quanto a "PDF e WORD, onde ao salvar todos esses arquivos em um somente", não entendi o que quer dizer com isto.

[]s

 
Postado : 28/01/2014 1:17 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Talvez uma das rotinas abaixo te ajude. A primeira trata-se de uma adaptação feita pelo Kazu que eu tenho guardado em meu acervo. Observem que ele usa o 7ZIP

Ja a segunda rotina, confesso que não me recordo o autor, mas faz backup de um arquivo EXCEL zipado.

Option Explicit
 
Dim nome_zip        As Variant
Dim pasta_a_zipar   As Variant
Dim strDate         As String
Dim Pasta_destino   As String
Dim oApp            As Object
 
 
Sub Zipar_tudo_com_7Zip()
   
    'Pasta onde estará o arquivo zipado
    Pasta_destino = "C:UserstodorokDesktop"
 
    'Pasta que contém os arquivos a serem zipados
    pasta_a_zipar = "C:UserstodorokDesktopKaizen"
 
    'Arquivo zip que contém os arquivos compactados
    nome_zip = Pasta_destino & "backup" & ".zip"
 
    'Criar um arquivo zip vazio
    Call Novo_zip_vazio(nome_zip)
 
    Set oApp = CreateObject("Shell.Application")
    'Copiar os arquivos para dentro do arquivo zip vazio
    oApp.NameSpace(nome_zip).CopyHere oApp.NameSpace(pasta_a_zipar).Items
 
    'Aguardar o término da compactação
    On Error Resume Next
    Do Until oApp.NameSpace(nome_zip).Items.Count = oApp.NameSpace(pasta_a_zipar).Items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
 
    MsgBox "Fim!"
End Sub
 
Sub Novo_zip_vazio(sPath)
    'Se já existir um arquivo zip, apagá-lo e criar um novo
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub

SEGUNDA ROTINA

Sub Zip_Folder_And_SubFolders()
    Dim PathWinZip As String, FileNameZip As String, FolderName As String
    Dim ShellStr As String, strDate As String, DefPath As String
 
    PathWinZip = "C:program fileswinzip"
    'This will check if this is the path where WinZip is installed.
    If Dir(PathWinZip & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Sub
    End If
 
    ' Build the date/Time string
    strDate = Format(Now, "yyyy-mm-dd h-mm-ss")
 
    ' Build the path and name for the zip file
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "" Then
        DefPath = DefPath & ""
    End If
    FileNameZip = DefPath & strDate & ".zip"
 
    'Fill in the folder name
    FolderName = "C:Data"
 
    'Add a slash at the end if the user forget it
    If Right(FolderName, 1) <> "" Then
        FolderName = FolderName & ""
    End If
 
     'Zip the folder, -r is Include subfolders, -p is folder information
    ShellStr = PathWinZip & "Winzip32 -min -a -r -p" _
               & " " & Chr(34) & FileNameZip & Chr(34) _
               & " " & Chr(34) & FolderName & Chr(34)
    ShellAndWait ShellStr, vbHide
 
    MsgBox "The zipfile is ready in: " & FileNameZip
End Sub
 
Postado : 28/01/2014 2:33 pm
(@douglaslm)
Posts: 12
Eminent Member
Topic starter
 

Reformulando a pergunta....

Tenho em média 20 pastas onde nelas contem arquivos (word, excel, PDF, JPEG), gostaria de zipar cada uma delas através do VBA, onde cada pasta a ser zipada fique com um nome determinado por mim.

 
Postado : 29/01/2014 1:28 pm