0

I am trying to extract some data from a series of zip files and store them in the same sheet I'm working on. I have already extract name of each zip file and store them in one column of the sheet. I want to loop through them to extract data I need, however, I keep getting error of "run time error 91" when I access the oApp.Namespace(zipName).Items. Here is the VBA code I have, can anyone help me with that? Thanks!

Sub GetData()
Dim iRow As Integer 'row counter
Dim iCol As Integer 'column counter
Dim savePath As String 'place to save the extracted files
Dim fileContents As String 'contents of the file
Dim fso As FileSystemObject 'FileSystemObject to work with files
iRow = 1 'start at first row
iCol = 1 'start at frist column
'set the save path to the temp folder
savePath = Environ("TEMP")
'create the filesystem object
Set fso = New FileSystemObject

Do While ActiveSheet.Cells(iRow, iCol).Value <> ""
    fileContents = fso.OpenTextFile(UnzipFile(savePath, ActiveSheet.Cells(iRow, iCol).Value, "Device-1_IR_VR_7-16-2019-2-32-55_PM.pda-iv.txt"), ForReading).ReadAll
    ActiveSheet.Cells(iRow, iCol).Value = fileContents
    iRow = iRow + 1
Loop


'free the memory
Set fso = Nothing
End Sub

Function UnzipFile(savePath As String, zipName As String, fileName As String) As String
Dim oApp As Shell
Dim strFile As String
'get a shell object
Set oApp = CreateObject("Shell.Application")
    'check to see if the zip contains items
    'Debug.Print oApp.Namespace(zipName).Items.Count
  If Not IsNull(oApp.Namespace(zipName).Items) Then
    If oApp.Namespace(zipName).Items.Count > 0 Then
        Dim i As Integer
        'loop through all the items in the zip file
        For i = 0 To oApp.Namespace(zipName).Items.Count - 1
            'check to see if it is the txt file
            If UCase(oApp.Namespace(zipName).Items.Item(i)) = UCase(fileName) Then
                'save the files to the new location
                oApp.Namespace(savePath).CopyHere oApp.Namespace(zipName).Items.Item(i)
                'set the location of the file
                UnzipFile = savePath & "\" & fileName
                'exit the function
                Exit Function
            End If
        Next i
    End If
   End If
'free memory
Set oApp = Nothing

End Function
  • Not too familiar with powershell but I had a quick read of [this Shell.Namespace method](https://learn.microsoft.com/en-us/windows/win32/shell/shell-namespace) documentation which seems to indicate you need to set `oApp` again with the namespace first, then check if it's empty/count - Specifically these 2 lines: `set objShell = CreateObject("shell.application")` then `set objFolder = objShell.NameSpace("C:\\")` – Samuel Everson Jun 08 '21 at 23:00
  • When working with shell namespaces you should use paths declared as Variant and not as String. https://stackoverflow.com/questions/31128248/excel-vba-shell-namespace-returns-nothing – Tim Williams Jun 08 '21 at 23:07
  • @TimWilliams Thanks for the reaching out. I did research on this and found you are correct about my error. Now the problem is that I have already stored all .zip files that I want to work with in my worksheet and I need to pass the names of them to my ``UnzipFile`` function. However, I don't think there is a way for me to set the value of a cell to be type of variant. Do you have any ideas on this? – Stephen1999 Jun 09 '21 at 19:07
  • In your unzip method you can wrap the variables in CVar() – Tim Williams Jun 09 '21 at 19:49

1 Answers1

1

Swap your variables to Variant if they're going to be passed to Shell:

Sub GetData()
    Dim iRow As Long                'row counter
    Dim iCol As Long                'column counter
    Dim savePath As Variant         'place to save the extracted files
    Dim zipName As Variant
    Dim txtPath As String
    Dim fileContents As String      'contents of the file
    Dim fso As FileSystemObject     'FileSystemObject to work with files
    
    iRow = 1                        'start at first row
    iCol = 1                        'start at first column
    savePath = Environ("TEMP")      'set the save path to the temp folder
    Set fso = New FileSystemObject  'create the filesystem object
    
    Do While ActiveSheet.Cells(iRow, iCol).Value <> ""
        zipName = ActiveSheet.Cells(iRow, iCol).Value
        txtPath = UnzipFile(savePath, zipName, "Device-1_IR_VR_7-16-2019-2-32-55_PM.pda-iv.txt")
        If Len(txtPath) > 0 Then 'if found the file...
            fileContents = fso.OpenTextFile(txtPath, ForReading).ReadAll
            ActiveSheet.Cells(iRow, iCol).Value = fileContents
        End If
        iRow = iRow + 1
    Loop
End Sub

Function UnzipFile(savePath As Variant, zipName As Variant, fileName As String) As String
    Dim oApp As Object, ns As Object, i As Long
    
    Set oApp = CreateObject("Shell.Application")    'get a shell object
    Set ns = oApp.Namespace(zipName)                'get the zip namespace
    If ns.Items.Count > 0 Then
        For i = 0 To ns.Items.Count - 1
            'check to see if it is the txt file
            If UCase(ns.Items.Item(i)) = UCase(fileName) Then
                'save the files to the new location
                oApp.Namespace(savePath).CopyHere ns.Items.Item(i)
                UnzipFile = savePath & "\" & fileName 'return the location of the file
                Exit Function
            End If
        Next i
    End If
End Function
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • I took your advise and try different kinds of code snippets myself, including yours, but them same error occurred again on my end at the line `If Not IsNull(ns.Items) Then`. Do you think I should just unzip my file in the main loop? Thanks! – Stephen1999 Jun 09 '21 at 21:52
  • I don't think you need that `isnull()` check - a zip archive needs at least one item in it. – Tim Williams Jun 09 '21 at 22:00
  • this is nuts, but I will take it as an answer. Thanks! – Tomamais Apr 29 '23 at 23:57