unzip file on server 1

[saltir]

Hi all,
I would really appreciate your help as I am quite new to this.
I have a zipfile z":\Databases\Reconciliations\01042012.zip" and i would like to copy its contents (test1.txt,test2.txt) onto my local hard disc through VBA for then to import in a db.

I have tried with the Dir and filecopy function,but i guess this won't work since it is a zip file


Any help would be greatly appreciated.


Thanks

 

[PHV]

You may use a procedure like this:

Sub doUnzip(strZipFile As String, strDestDir As String)
Dim objSA As Object: Set objSA = CreateObject("Shell.Application")
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim ZF: ZF = strZipFile
Dim DD: DD = strDestDir
If Not objFSO.FolderExists(DD) Then objFSO.CreateFolder DD
objSA.NameSpace(DD).CopyHere objSA.NameSpace(ZF).Items
Set objFSO = Nothing
Set objSA = Nothing
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[MazeWorX]

I use this to do exactly what you want to do ... works like a charm. slighly modified so i can post it but all you need to provide is the Server location of the zip file and the local folder location to the UnzipFile Function. This will also uzip self exec zip files without issue

Option Compare Database
Option Explicit

Declare Function OpenProcess Lib "kernel32" _
                             (ByVal dwDesiredAccess As Long, _
                              ByVal bInheritHandle As Long, _
                              ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
                                    (ByVal hProcess As Long, _
                                     lpExitCode As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
    On Error GoTo xxx
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long
    'fill in the missing parameter and execute the program
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    'hProg is a "process ID under Win32. To get the process handle:
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        'populate Exitcode variable
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
    Exit Sub

xxx:
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & _
           vbCrLf & Error$, vbExclamation, "Modules - ShellAndWait"
    Exit Sub
End Sub

Function UnzipFile() As Boolean

    Dim PathZipProgram As String
    Dim ShellStrDaily As String
    Dim strDaily As String
    Dim NameUnZipFolder As String
    
    On Error GoTo UnzipFile_Error

    PathZipProgram = "C:\program files\winzip"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If
    'Check if this is the path where WinZip is installed.
    If Dir(PathZipProgram & "winzip32.exe") = "" Then
        MsgBox "Please find your copy of winzip32.exe and try again"
        Exit Function
    End If

    strDaily = "Z:\PathtoZipFileonServer"
    NameUnZipFolder = "C:\LocalFolderLocation"

    ShellStrDaily = PathZipProgram & "Winzip32.exe -min -e -o" _
                  & " " & Chr(34) & strDaily & Chr(34) _
                  & " " & Chr(34) & NameUnZipFolder & Chr(34)
    'use shell and wait to unzip and make sure winzip is finished before proceeding
    ShellAndWait ShellStrDaily, vbHide

    UnzipFile = True

    On Error GoTo 0
    Exit Function

UnzipFile_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure UnzipFile of Module Module5"
End Function

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>