none
Abrir arquivos em PDF, localizados dentro de uma pasta zipada via VBA RRS feed

  • Pergunta

  • Prezados,

    Gostaria de saber se é possível utilizar um código em VBA para abrir arquivos localizados dentro de uma pasta zipada. Caso, possível, poderiam compartilhar o código?

    Desde já agradeço.

    Atenciosamente,

    Vitor

    quinta-feira, 10 de março de 2016 15:45

Respostas

  • Vitor,

    Tenta assim:

     Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    
    Sub Unzip2()
        Dim FSO As Object
        Dim oApp As Object
        Dim Fname As Variant
        Dim FileNameFolder As Variant
        Dim DefPath As String
        Dim strDate As String
        Dim fileNameInZip As Variant
    
        Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                            MultiSelect:=False)
        If Fname = False Then
            'Do nothing
        Else
            'Root folder for the new folder.
            'You can also use DefPath = "C:\Users\Ron\test\"
            DefPath = Application.DefaultFilePath
            If Right(DefPath, 1) <> "\" Then
                DefPath = DefPath & "\"
            End If
    
            'Create the folder name
            strDate = Format(Now, " dd-mm-yy h-mm-ss")
            FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
    
            'Make the normal folder in DefPath
            MkDir FileNameFolder
    
            'Extract the files into the newly created folder
            Set oApp = CreateObject("Shell.Application")
    
            'Change this "*.txt" to extract the files you want
            For Each fileNameInZip In oApp.Namespace(Fname).Items
                If LCase(fileNameInZip) Like LCase("*.pdf") Then
                    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).Items.Item(CStr(fileNameInZip))
                    'Shell FileNameFolder & fileNameInZip
                    ShellExecute 0, "Open", FileNameFolder & fileNameInZip, "", "", vbNormalNoFocus
                End If
            Next
    
            'MsgBox "You find the files here: " & FileNameFolder
    
            On Error Resume Next
            Set FSO = CreateObject("scripting.filesystemobject")
            FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
            
        End If
        
    End Sub



    Fonte: http://www.rondebruin.nl/win/s7/win002.htm

    Natan


    quinta-feira, 10 de março de 2016 16:54

Todas as Respostas

  • Sub Teste()
    Call UnZip("D:\Bases\Teste", "D:\Bases\teste.Zip")
    End Sub
    
    
    Sub UnZip(strTargetPath As String, Fname As Variant)
    Dim oApp As Object, FSOobj As Object
    Dim FileNameFolder As Variant
    
    If Right(strTargetPath, 1) <> Application.PathSeparator Then
    strTargetPath = strTargetPath & Application.PathSeparator
    End If
    
    FileNameFolder = strTargetPath
    
    Set FSOobj = CreateObject("Scripting.FilesystemObject")
    If FSOobj.FolderExists(FileNameFolder) = False Then
    FSOobj.CreateFolder FileNameFolder
    End If
    
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
    'oApp.Namespace(CVar(FileNameFolder)).CopyHere oApp.Namespace(CVar(Fname)).items
    
    Set oApp = Nothing
    Set FSOobj = Nothing
    Set FileNameFolder = Nothing
    End Sub

    Com esse código, você pode descompactar o zip em uma pasta qualquer e ter acesso aos arquivos.

    Att,


    Antero Marques

    quinta-feira, 10 de março de 2016 16:49
  • Vitor,

    Tenta assim:

     Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    
    Sub Unzip2()
        Dim FSO As Object
        Dim oApp As Object
        Dim Fname As Variant
        Dim FileNameFolder As Variant
        Dim DefPath As String
        Dim strDate As String
        Dim fileNameInZip As Variant
    
        Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                            MultiSelect:=False)
        If Fname = False Then
            'Do nothing
        Else
            'Root folder for the new folder.
            'You can also use DefPath = "C:\Users\Ron\test\"
            DefPath = Application.DefaultFilePath
            If Right(DefPath, 1) <> "\" Then
                DefPath = DefPath & "\"
            End If
    
            'Create the folder name
            strDate = Format(Now, " dd-mm-yy h-mm-ss")
            FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
    
            'Make the normal folder in DefPath
            MkDir FileNameFolder
    
            'Extract the files into the newly created folder
            Set oApp = CreateObject("Shell.Application")
    
            'Change this "*.txt" to extract the files you want
            For Each fileNameInZip In oApp.Namespace(Fname).Items
                If LCase(fileNameInZip) Like LCase("*.pdf") Then
                    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).Items.Item(CStr(fileNameInZip))
                    'Shell FileNameFolder & fileNameInZip
                    ShellExecute 0, "Open", FileNameFolder & fileNameInZip, "", "", vbNormalNoFocus
                End If
            Next
    
            'MsgBox "You find the files here: " & FileNameFolder
    
            On Error Resume Next
            Set FSO = CreateObject("scripting.filesystemobject")
            FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
            
        End If
        
    End Sub



    Fonte: http://www.rondebruin.nl/win/s7/win002.htm

    Natan


    quinta-feira, 10 de março de 2016 16:54
  • Prezado Antero, boa noite.

    Gostaria de saber se é possível a utilização de algum código em VBA para abrir diretamente um determinado arquivo dentro dessa pasta zipada em vez de descompactar o zip em uma pasta qualquer e, assim, ter acesso aos arquivos.

    Agradeço desde já.

    Atenciosamente,

    Leandro

    terça-feira, 15 de março de 2016 21:24
  • Leandro,

    Achei algumas coisas, mas com ferramentas de terceiros. Não creio que seja uma boa alternativa.

    Você deu uma olhada no código do Natan ?

    É mais interessante, porque se você quiser, pode extrair apenas o arquivo que você quer.

    No lugar de 

    If LCase(fileNameInZip) Like LCase("*.pdf") Then

    você pode colocar o nome específico do teu arquivo

    If LCase(fileNameInZip) Like LCase("documento.pdf") Then

    Att,


    Antero Marques


    terça-feira, 15 de março de 2016 22:41
  • @Leanper,

    A resposta do Natan mostra como copia um arquivo específico.


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    quarta-feira, 16 de março de 2016 19:25
    Moderador