VBA unzip not working

[Euler271]

Hello,

I'm trying to use VBA to unzip a downloaded file but it doesn't work unless I'm in debug mode and step through the command. I then set up a Do...Loop to continue looping until one of the files appears in the target folder:

1. Set oApp = CreateObject("Shell.Application")
2. Do
3. oApp.Namespace(TextFileLocation).CopyHere oApp.Namespace(DownloadLocation & Fname).Items
4. Loop Until IfExists(TextFileLocation & Demo & ".txt")

For some reason the loop doesn't seem to work either. In other words, the code leaves the loop even when the file doesn't exist in the target folder. If I break at line 3 then step through the code, it unzips then leaves the loop. Obviously, I want the code to work without having to break at the critical line.



Any ideas? Thanks.

[isladogs]

Have you considered using a generic vba file handler such as fHandleFile which will open the zip file in its default application

[Euler271]

Have you considered using a generic vba file handler such as fHandleFile which will open the zip file in its default application

No, I'm using code I found on websites.

[isladogs]

If I post the fHandleFile function on this website, would you like to try it?

[Euler271]

Sure, I'd be glad to try it. Thank you.

[isladogs]

Here you are.
Place the code below in a standard module:

Option Compare Database
Option Explicit

'Code Courtesy of Dev Ashish

Private Declare Function apiShellExecute 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

Function fHandleFile(stFile As String, lShowHow As Long)

On Error GoTo Err_Handler

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
                
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in fHandleFile procedure : " & Err.description, vbOKOnly + vbCritical
    Resume Exit_Handler

End Function

NOTE; If using 64-bit Access the api declaration will need adapting for 64-bit

USAGE:
All you need to do is call the application with the path of the file and let Windows do the rest.
This code can be used to start any registered applications, including another instance of Access.
If it doesn't know what application to open the file with, it just pops up the standard "Open With.." dialog.
It can even handle URL's and mailto:

'Open a Word doc
fHandleFile "C:\TEMP\MyFile.docx",WIN_NORMAL
OR
'Call fHandleFile ("C:\TEMP\MyFile.docx",WIN_NORMAL)

'Open a folder:
' fHandleFile "C:\TEMP",WIN_NORMAL
OR
'Call fHandleFile ("C:\TEMP",WIN_NORMAL)

'Call Email app:
' fHandleFile "mailto:bpo@yahoo.com",WIN_NORMAL

'Open URL:
' fHandleFile "http://uk.yahoo.com";, WIN_NORMAL

'Handle Unknown extensions:
' fHandleFile "C:\TEMP\TestThis.xyz",Win_Normal

[Euler271]

Thank you for posting that.

Do I change "shell32.dll" to "shell64.dll" for 64-bit? Is that the only change?

What is the constant value for "ERROR_SUCCESS"?

Thank you again.

[isladogs]

Not quite that simple.
Apologies for omitting the constants section before

The code below covers both 32-bit & 64-bit (it works though purists may not like the way I've done it0
Constants also included this time

Option Compare Database
Option Explicit

'Code Courtesy of Dev Ashish

'=================================================
#If VBA7 Then 'Add PtrSafe - required for 64-bit Office (VBA7)
    Public Declare PtrSafe Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
            lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, _
            lpTotalNumberOfClusters As Long) As Long
#ElseIf Win64 Then 'need datatype LongPtr
    Public Declare PtrSafe Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
            lpSectorsPerCluster As LongPtr, lpBytesPerSector As LongPtr, lpNumberOfFreeClusters As LongPtr, _
            lpTotalNumberOfClusters As LongPtr) As LongPtr
#Else
    Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
            lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, _
            lpTotalNumberOfClusters As Long) As Long
#End If
'=================================================

Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&


Function fHandleFile(stFile As String, lShowHow As Long)

On Error GoTo Err_Handler

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
                
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in fHandleFile procedure : " & Err.description, vbOKOnly + vbCritical
    Resume Exit_Handler

End Function

[Euler271]

Thank you for the code you supplied.

I've found that your code calls WinZip but doesn't automatically unzip the file and send the contents to a target folder. That's what I really need to happen.

My original code seems like it should work so I don't understand why it doesn't.

[isladogs]

Sorry about that. I only said it would open the file using the default handler.
I can't tell you what's wrong with your code as I've not used anything like it.

Try checking whether the code compiles. You may have a missing declaration e.g. OApp or a reference issue

[Euler271]

Yes, it compiles without an issue and all my variables are declared.

[isladogs]

Ok, suggest you return to the source of your code and ask there.
I'll drop out now as I can't advise further.
Good luck