Issue Opening Multiple Workbooks in Folder using Loop and FileSystemObject

[AlexB123]

Hello all,

I have a macro that uses a For Each loop and a FileSystemObject to open six files that are placed in a certain folder. The names of the files are similar, except for a number at the end of the filename. For example,

Alex Report - 104
Alex Report - 105
Alex Report - 106
Alex Report - 107

The code will loop through all but one file, then break with the warning "Object Variable Not Set" on the line "Set objSh = objWB.Sheets(1)".

I discovered that the code opens up two files, at the same time - the top file and another (always ending in '108'), on the first iteration of the loop. The code then continues to run, processing all files except for the second file that opened on the first iteration (and which never processed).

I think that the code wants to complete reading the only file left, i.e., "Alex Report - 108", but cannot because it mistakenly opens two files at once and then forgets it's there.

Any ideas as to what's happening? Or how to fix? Thanks

    Dim objFSO As Object
    Dim SourceFolder As Object
    Dim objFile As Object
       
    strPath = "C:\AlexDrive\Import Files\"
    strFileName = "*.csv*"
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = objFSO.GetFolder(strPath)
            
    For Each objFile In SourceFolder.Files
        
        Dim objWB As Workbook
        Dim objSh As Worksheet
        
        If objFile.Name Like strFileName Then
            Set objWB = Workbooks.Open(objFile.Path)
            Set objSh = objWB.Sheets(1)
            
            'determine file type
            If objWB.Name Like "*405*" Then ocrType = 405
            If objWB.Name Like "*407*" Then ocrType = 407
            If objWB.Name Like "*408*" Then ocrType = 408
            If objWB.Name Like "*418*" Then ocrType = 418
            If objWB.Name Like "*420*" Then ocrType = 420
            If objWB.Name Like "*452*" Then ocrType = 452
            
            If ocrType <> 0 Then
                        objWB.SaveAs pathFull & objWB.Name
                        
                        'if there are no 405 items then skip file after archive
                        If ocrType = 405 And num405items < 1 Then GoTo skip405
                        
                        datalastrow = objSh.Rows.Range("B300000").End(xlUp).Row
                        
                        'scope for 405
                        If ocrType = 405 Then
                            'stuff
                            datalastrow = objSh.Rows.Range("b300000").End(xlUp).Row
                            objSh.Range("AH2").Formula = "=VLOOKUP(B2,'[" & ckNumWB.Name & "]405'!$A:$A,1,0)"
                            objSh.Range("AH2").Copy
                            objSh.Range("AH2:AH" & datalastrow).PasteSpecial
                            objSh.Range("$A$1:$AH$" & datalastrow).AutoFilter Field:=34, Criteria1:="<>#N/A"
                        End If
                        
                        'scope needed for 407, 420 148
                        If ocrType = 407 Or ocrType = 420 Or ocrType = 418 Then
                            'pull up reference sheet
                            'do other stuff
                            datalastrow = objSh.Rows.Range("b300000").End(xlUp).Row
                            objSh.Range("AG2").Formula = "=IFERROR(VLOOKUP(""""&X2,'[" & scopeWB.Name & "]Sheet1'!A:C,3,0),VLOOKUP(""""&z2,'[" & scopeWB.Name & "]Sheet1'!A:C,3,0))"
                            objSh.Range("AG2").Copy
                            objSh.Range("AG2:AG" & datalastrow).PasteSpecial
                            objSh.Range("$A$1:$AG$" & datalastrow).AutoFilter Field:=33, Criteria1:="<>#N/A"
                        End If
                        
                        'remove action code 4 and 10
                        objSh.Range("$A$1:$AG$" & datalastrow).AutoFilter Field:=31, Criteria1:="<>4", Operator:=xlAnd, Criteria2:="<>10"
                        
                        'new uploads
                        objSh.Range("$A$1:$AG$" & datalastrow).AutoFilter Field:=3, Operator:=xlFilterValues, Criteria2:=Array(1, filtDate1)
                        objSh.Range("A1:AH" & Rows.Range("b300000").End(xlUp).Row).Copy
                            'Workbooks(NewFile).Activate
                            
                            linklastrow1 = newSh1.Rows.Range("B200000").End(xlUp).Row
                            If linklastrow1 = 1 Then
                                newSh1.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            Else
                                newSh1.Range("A" & linklastrow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                newSh1.Range(linklastrow1 + 1 & ":" & linklastrow1 + 1).Delete xlShiftUp
                            End If
                        'check nums for clearing
                        objSh.Range("$A$1:$AG$" & datalastrow).AutoFilter Field:=3, Criteria1:="<" & filtDate2, Operator:=xlAnd
                        objSh.Range("B1:B" & objSh.Rows.Range("b300000").End(xlUp).Row).Copy
                            
                            linklastrow2 = newSh2.Rows.Range("A300000").End(xlUp).Row
                            If linklastrow2 = 1 Then
                                newSh2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            Else
                                newSh2.Range("A" & linklastrow2 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                newSh2.Range(linklastrow2 + 1 & ":" & linklastrow2 + 1).Delete xlShiftUp
                            End If
                                                
skip405:
                        'close and delete file
                        objWB.Close False
                        Kill objFile
                        DoEvents
            Else
                        filesNotReady = filesNotReady + 1
                        objWB.Close
            End If
        
        
        End If
        
    Set objWB = Nothing
    Set objSh = Nothing
        
    Next objFile
    
    Set objFSO = Nothing
    Set SourceFolder = Nothing

 

[Norie]

What do you mean by 'top' file?

Where is this code located and where is the file it's in located?

Where does this save the file(s) you've just opened?

           objWB.SaveAs pathFull & objWB.Name

 

[AlexB123]

Hi Norie,

By "top file" I meant the file with the lowest integer, i.e. "* - 104.xlsx".

The code is stored in a folder for macro workbooks. The "newSh1" and "newSh2" are sheets of a new workbook, created by the macro.

The files that are opened are saved in a third folder (see below):

Dim macroPath As String: macroPath = "C:\AlexDrive\DB\MacroFiles\"
 Dim newWBPath As String: newWBPath = "C:\AlexDrive\DB\WorkFiles\"
 Dim pathFull As String: pathFull = "C:\AlexDrive\DB\Archive\Alex Files\"

 

[Norie]

As far as I can see that code only opens one workbook at a time, processes it, closes it and then moves onto the next workbook.

When you run it are any other workbooks open?

 

[AlexB123]

Yes ... I've been running it with a few other workbooks open.

Additionally, before the loop, the macro opens seven other workbooks that are used in its operations.

I can try closing out my personal workbooks, and only run the macroworkbook (and it's seven called workbooks)?

 

[AlexB123]

I found the issue ...

I tried to close out all my other Workbooks, but it still wasn't working. I looked very carefully at the Workbooks.Open statement, and nothing was wrong there. I decided to check the early portion of the code, and the error was a copy of the offending workbook located in the path of another open statement.

Excel didn't break, just me!

Thanks for the help. I was worried the FileSystemObject was the cause.