Compactação/Compressão de arquivos txt com VBA (Office 2007)

Boa noite

Preciso de um auxilio para compressão/compactação de arquivos txt via vba.

Encontrei um post aqui no forum, mas não funciona com office 2007.  http://maximoaccess.forumeiros.com/t477-resolvidocompactar-arquivo-pelo-access

Public Sub ZipaFicheiro()
'Criado pelo meu amigo e colega Raw do Canadá
'Adaptado por JPaulo ® Maximo Access
Dim strDate As String, DefPath As String
Dim oApp As Object
Dim FName, FileNameZip
Dim strPrefix As String
On Error Resume Next
DefPath = "C:\SuaPasta"'Local e pasta
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If
strDate = Format(Now, "dd-mmm-yy_h-mm-ss")
FileNameZip = DefPath & strDate & ".zip"
strPrefix = "planilha não alterada" 'Nome do ficheiro
FName = "C:\SuaPasta" & strPrefix & ".xls"
On Error Resume Next
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

Encontrei um codigo similar mas também apresenta o erro "Method NameSpace of object 'IShellDispatch4' failed" na linha objOApp.Namespace(varFileNameFolder).CopyHere objOApp.Namespace(FileNameToUnzip).items, 24

Também tentei Shell ("C:\Program Files\PKWARE\PKZIPW\PKZIPWR a c:\temp\teste.zip c:\temp\teste.pdf") sem sucesso. O zip inicia mas não adiciona o arquivo.

Alguém consegue me dar uma luz a respeito de como resolver o erro ou algum outro codigo ?

abs

Ola;

Fiz o teste com um txt no MS 2007 e funciona sim;

Se tiver problemas, copie o seu ficheiro para outra drive sem ser a "C:\" e teste;

Dim strDate As String, DefPath As String
Dim oApp As Object
Dim FName, FileNameZip
Dim strPrefix As String
On Error Resume Next

DefPath = "D:\" 'Local onde se encontra 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 = "teste" 'Nome do ficheiro sem extensão
        FName = "D:\" & strPrefix & ".txt"
    
    On Error Resume Next
        CriaNovoZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        oApp.NameSpace(FileNameZip).CopyHere FName
        MsgBox "Criado com Sucesso em: " & FileNameZip
Set oApp = Nothing
Exit Sub

JPaulo
 
Testei o codigo que vc postou no c: e em outro diretorio de rede.
O zip foi criado, mas o arquivo teste.txt não foi adicionado porque o código não esta reconhecendo o namespace.
Eu referenciei a biblioteca do Excel, mas não adiantou. Sabe se é preciso fazer referencia a alguma outra biblioteca ?
 
Obrigado

Em todos os testes que fiz, funfou.

Faça um outro teste, renomeando para nomes sem espaços, tanto o caminho como o ficheiro.

Ja havia feito isso...

?FileNameZip
c:\temp\07-abr-14_17-26-15.zip
?FName
c:\temp\teste.txt

Mas depois de varios testes me atentei que estou usando um app chamado SecuryZIP...
Talvez o problema seja justamente esse. O zip é criado mas não adiona o arquivo...

Bem vou fazer algumas persquisas em cima disso.

Obrigado pela ajuda.
abs