err 91 Object Variable or With Block Variable not set

[rjwebgraphix]

I was really trying to do this new personal project without direct help, but alas, I have run into a problem that I've been banging my head on the desk for a few days and broke down to ask the question.

The failing portions of the code comes directly from Unzip file or files with the default Windows zip program (VBA) and uses Example 2. Their example works, mine does not, although I cannot see what I've changed to break it. The only things changed are the names of the variables and I have double and triple, quadruple and 100 times over checked every if and end if statement is there.

I'm getting "err 91 Object Variable or With Block Variable not set" on this line....

For Each FileInZip In oApp.Namespace(TargetFile).items

There are no with blocks, so it's obviously thinking the object variable is not set, but it is set with this line...

Set oApp = CreateObject("Shell.Application")

I don't get it. It shouldn't have anything to do with doing it in a loop, whereas the example is direct and not in a loop. Below is my full code as it sits now as I'm sure you can't tell much from the 2 snippets above. I have hard coded a single filename and path for the sake of testing, but left in the commented portions of how it gets the filepath and filenames.

Sub ImportFileInfo()

'Declare Sheets
Dim FileSHT As Worksheet
Dim ControlSHT As Worksheet
Set FileSHT = Sheets("Files")
Set ControlSHT = Sheets("Control")

'Declare Range for Files
Dim lr As Long
Dim c1 As Range, c2 As Range, rng As Range
lr = FileSHT.Range("A65536").End(xlUp).row
Set c1 = FileSHT.Cells(2, "A")
Set c2 = FileSHT.Cells(lr, "A")
Set rng = FileSHT.Range(c1, c2)

'Declarations for unzipping
Dim TargetFolder As String
Dim TargetFile As String
Dim ZipFolder As String
Dim FileInZip As Variant
Dim FileFolder As Variant
Dim IsFolderEmpty As Variant
Dim oApp As Object

'Declare diz
Dim DizOBJ
Dim DizFileFnd As Boolean
Dim DizFile As String
Dim DizData As String
Dim fs, a


For Each FileFolder In rng
    
'    TargetFolder = Cells(FileFolder.row, "A").Value
'    ChDir TargetFolder
'    TargetFile = Cells(FileFolder.row, "A").Value & "\" & Cells(FileFolder.row, "B").Value
'    ZipFolder = Cells(FileFolder.row, "A").Value & "\UnZiPPeD"
    TargetFolder = "c:\rj\excel\excel jeanie"
    ChDir TargetFolder
    TargetFile = "c:\rj\excel\excel jeanie\exceljeanie.zip"
    ZipFolder = "c:\rj\excel\excel jeanie\UnZiPPeD"
    
    
    If FileFolderExists(ZipFolder) Then
        'check for files in ZipFolder, if files are returned then delete them
        IsFolderEmpty = ListFiles(ZipFolder)
        If IsArrayAllocated(IsFolderEmpty) Then
            Kill ZipFolder & "\*.*"
        End If
    Else
        MkDir ZipFolder
    End If
    
    DizFileFnd = False
    Set oApp = CreateObject("Shell.Application")
    For Each FileInZip In oApp.Namespace(TargetFile).items
        If LCase(FileInZip) Like LCase("file_id.diz") Then
            oApp.Namespace(ZipFolder).CopyHere _
                    oApp.Namespace(TargetFile).items.Item(CStr(FileInZip))
            DizFile = ZipFolder & "\file_id.diz"
            DizFileFnd = True
        End If
    Next
    
    If DizFileFnd = True Then
'       Read Diz file into string
        DizData = TxtFileToString(DizFile)
        Cells(FileFolder.row, "C").Value = DizData
        MsgBox "Diz File Found" ' remove after test
        Exit Sub ' remove after test
    Else
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set a = fs.CreateTextFile(ZipFolder & "\file_id.diz", True)
        a.WriteLine ("Original Folder: " & Cells(FileFolder.row, "A") & Chr(10) & _
                     "Original Filename: " & Cells(FileFolder.row, "A"))
        a.Close
        '***Add code to add new diz file to zip***
        Cells(FileFolder.row, "C").Value = "Diz File NOT Found"
        MsgBox "Diz File NOT Found" ' remove after test
        Exit Sub 'remove after test
    End If
Next FileFolder
End Sub

Any assistance in debugging why it thinks the object is not set would be appreciated.

 

[rjwebgraphix]

Nevermind, I got it to work. I still don't know what caused it to fail. I took their original code and worked with it directly without changing much of anything and tested each step along the way, only this time I didn't break it.

I swear I've done this a dozen times, each time breaking it somewhere along the way. This time I did not, yet I really can't tell any functional difference between the two codes other than keeping more of their original variable names.

This works: Functions used left out for brevity.

Sub UnzipOriginal()

'Declare Sheets
Dim FileSHT As Worksheet
Dim ControlSHT As Worksheet
Set FileSHT = Sheets("Files")
Set ControlSHT = Sheets("Control")

Dim oApp As Object
Dim targetfile As Variant
Dim UnZipFolder As String
Dim fileNameInZip As Variant

Dim TargetFolder As String
Dim IsFolderEmpty As Variant

Dim DizFile As String
Dim DizFileFnd As Boolean
Dim DizData As String

Dim FileFolder As Variant
Dim fs, a

'Declare Range for Files
Dim lr As Long
Dim c1 As Range, c2 As Range, rng As Range
lr = FileSHT.Range("A65536").End(xlUp).row
Set c1 = FileSHT.Cells(2, "A")
Set c2 = FileSHT.Cells(lr, "A")
Set rng = FileSHT.Range(c1, c2)
    
For Each FileFolder In rng
    TargetFolder = Cells(FileFolder.row, "A").Value
    ChDir TargetFolder
    targetfile = Cells(FileFolder.row, "A").Value & "\" & Cells(FileFolder.row, "B").Value
    UnZipFolder = Cells(FileFolder.row, "A").Value & "\UnZiPPeD"

    If FileFolderExists(UnZipFolder) Then
        'check for files in ZipFolder, if files are returned then delete them
        IsFolderEmpty = ListFiles(UnZipFolder)
        If IsArrayAllocated(IsFolderEmpty) Then
            Kill UnZipFolder & "\*.*"
        End If
    Else
        MkDir UnZipFolder
    End If
    DizFileFnd = False
    '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(targetfile).items
        If LCase(fileNameInZip) Like LCase("file_id.diz") Then
            oApp.Namespace(UnZipFolder & "\").CopyHere _
                    oApp.Namespace(targetfile).items.Item(CStr(fileNameInZip))
            DizFile = UnZipFolder & "\file_id.diz"
            DizFileFnd = True
        End If
    Next
    DizData = ""
    If DizFileFnd = True Then
'       Read Diz file into string
        DizData = TxtFileToString(DizFile)
        Cells(FileFolder.row, "C").Value = DizData
'        MsgBox "Diz File Found" ' remove after test
'        Exit Sub ' remove after test
    Else
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set a = fs.CreateTextFile(UnZipFolder & "\file_id.diz", True)
        a.WriteLine ("Original Folder: " & Cells(FileFolder.row, "A"))
        a.WriteLine ("Original Filename: " & Cells(FileFolder.row, "B"))
        a.Close
        
        Cells(FileFolder.row, "C").Value = "Diz File NOT Found"
'        MsgBox "Diz File NOT Found" ' remove after test
'        Exit Sub 'remove after test
    End If
Next FileFolder

End Sub