2

Buscando, he localizado cómo descargar los archivos de un correo a la carpeta que necesito, ahora me encuentro con el problema que vienen comprimidos en .zip y tengo que descomprimirlos para cargarlos en la BBDD.

Buscando, he visto este código, que me da error en el ultimo paso. Me pueden ayudar no se donde esta el error y buscando no encuentro nada. Gracias.

introducir la descripción de la imagen aquí

Sub Descomprimir()

Dim Destino As String
Dim Origen As String
Dim oApp As Object

Destino = "C:\Users\PTbarbera\Desktop\descagasDatos\pruebaZip"
Origen = "C:\Users\PTbarbera\Desktop\descagasDatos\prueba.zip"

 Set oApp = CreateObject("Shell.Application")

  oApp.NameSpace(Destino).CopyHere 
  oApp.NameSpace(Origen).Items

End Sub 

El ultimo paso es el que me da el error: oApp.NameSpace(Destino).CopyHere oApp.NameSpace(Origen).Items.

¿No sé si tengo que activar alguna referencia?

introducir la descripción de la imagen aquí

1 respuesta 1

1

Aquí hay otro ejemplo de cómo descomprimir un archivo. la macro descomprime el archivo zip en una carpeta fija "C:\test\"

Sub Unzip()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String

    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False)
    If Fname = False Then
        'No hacer nada
    Else
        'Carpeta de destino
        DefPath = "C:\test\"    ' Cambia a tu ruta / variable
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        FileNameFolder = DefPath

        '        'Borre todos los archivos en la carpeta DefPath primero si lo desea
        '        En caso de error reanudar
        '        Kill DefPath & "*.*"
        '        En caso de error, vaya a 0 (GoTo 0)

        'Extraiga los archivos en la carpeta Destino
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

        MsgBox "Aquí encuentras los archivos: " & FileNameFolder

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

Aquí hay otros ejemplos útiles (traducir del inglés):

2
  • Muchas Gracias J.Rodriguez, Funciona perfectamente. saludos.
    – luis b
    Commented el 15 abr. 2018 a las 14:58
  • Hola, este código es el que uso y funciona perfecto!, lo único que no que le falta es poner la rurta directamente donde tengo los archivos guardados.
    – luis b
    Commented el 12 may. 2018 a las 21:45

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.