Ir para conteúdo
Fórum Script Brasil
  • 0

Vba Excel -zip


alexandrejpc10

Pergunta

2 respostass a esta questão

Posts Recomendados

  • 0

Use o seguinte código:

Sub Zip_File_Or_Files()
    Dim strDate As String, DefPath As String, sFName As String
    Dim oApp As Object, iCtr As Long, I As Integer
    Dim FName, vArr, FileNameZip

    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

    'Selecionar o arquivo(s), use o Ctrl para selecionar mais de 1 arquivo
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
                                        MultiSelect:=True, Title:="Selecione os arquivos a serem zipados")
    If IsArray(FName) = False Then
        'Não faz nada
    Else
        'Criar um arquivo Zip do Windows vazio
        NewZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        I = 0
        For iCtr = LBound(FName) To UBound(FName)
            vArr = Split97(FName(iCtr), "\")
            sFName = vArr(UBound(vArr))
            If bIsBookOpen(sFName) Then
                MsgBox "Você não pode zipar um documento aberto!" & vbLf & _
                       "Favor fechar o arquivo e tente novamente: " & FName(iCtr)
            Else
                'Copiar o documento para o diretório zipado
                I = I + 1
                oApp.NameSpace(FileNameZip).CopyHere (FName(iCtr))
            End If
        Next iCtr

        'Manter o código aguardando até acabar de zipar
        On Error Resume Next
        Do Until oApp.NameSpace(FileNameZip).items.Count = I
            Application.Wait (Now + TimeValue("0:00:01"))
        Loop

        MsgBox "Você encontrará o arquivo zipado aqui: " & FileNameZip
        On Error GoTo 0
        Set oApp = Nothing
    End If
End Sub

Atenciosamente,

Vagner Nicolodi

Link para o comentário
Compartilhar em outros sites

  • 0

Amigo Vagner,

Por favor, preciso de sua ajuda.

É a respeito de sua solução : http://scriptbrasil.com.br/forum/index.php?showtopic=87072

Tentei executar porém me aparece a mensagem "Erro de compilação: 'Sub' ou 'Function' não definida", selecionando o comando NewZip onde está a linha de comando "NewZip (FileNameZip)".

Tentei resolver definindo NewZip como uma variável, etc mas não tive êxito em nenhuma tentativa.

Por isto gostaria de lhe perguntar se você está chamando NewZip de alguma DLL.

Caso seja isto, por favor você poderia me enviar esta DLL ou me informar se é necessário habilitar algum Componente em Menu/Ferramentas/Referências no VBExcel??

Desde Já, Muito Obrigado!!

Link para o comentário
Compartilhar em outros sites

  • 0

Vagner,

bom dia!

estou acompanhando esse seu código para criar zip!

tem como substituir o " FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _

MultiSelect:=True, Title:="Selecione os arquivos a serem zipados") " por uma variável onde ele pega o arquivo direto em um lugar especifico, sem selecionar?

preciso dessa ajuda obrigado!

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...