Abrir pasta zipada por Vba

Boa tarde companheiros,

Uma vez criei um botão no meu BD que abria uma pasta dentro do Drive da empresa. O nome dessa pasta era a matricula do funcionário, por onde eu fazia o link. Utilizei o código abaixo:

Código:


Dim dossie As String

dossie = "explorer.exe P:\Interna\EQUIPE\DOSSIES\" & Me.txtmatricula & "\"
Shell dossie, vbNormalFocus



Contudo, dessa vez preciso abrir uma pasta com a matrícula do funcionário, mas ela está dentro de um arquivo zipado. Além disso, por serem arquivos grandes eles estão divididos pelo primeiro número da matrícula (Ex: todas as matrículas começadas por "0" estão dentro da pasta "Matrículas 0", que é a pasta zipada)

Seria possível fazer algo do tipo?

Ainda continuo com a dúvida, se alguém tiver alguma ideia agradeço.

Olá guism,

Veja este link,

http://ptcomputador.com/Software/data-compression/112163.html

Ou:

https://www.maximoaccess.com/t27588-resolvidodescompactar-arquivo-via-vba-usando-7z

Ou aqui mesmo no fórum com o João Paulo (JPaulo):

https://www.maximoaccess.com/t477-resolvidocompactar-arquivo-pelo-access

Código:


Private Sub DescomprimeZIP()
    Dim FSO As Object
    Dim oApp As Object
    Dim strDiretorioFicheiro As Variant
    Dim strPastaDestino As Variant
    Dim strDriveDestino As String

    strDiretorioFicheiro = "C:\SeuFicheiro.zip"
    
    If strDiretorioFicheiro = False Then
        'Não faz nada
    Else
         'Drive de destino
        strDriveDestino = "D:"
         If Right(strDriveDestino, 1) <> "\" Then
            strDriveDestino = strDriveDestino & "\"
        End If

        'Nome para a pasta de destino
        strPastaDestino = strDriveDestino & "NovaPasta\"

            If Len(Dir(strPastaDestino, vbDirectory)) = 0 Then
                      
        'Se a pasta de destino não existir, cria uma nova
        MkDir strPastaDestino
Else
End If
        'Extraí os ficheiros do .zip na pasta de destino
        Set oApp = CreateObject("Shell.Application")

        oApp.Namespace(strPastaDestino).CopyHere oApp.Namespace(strDiretorioFicheiro).items

        MsgBox "Ficheiros depositados em " & strPastaDestino

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If
End Sub