Thread: Run Time Error '1004' File Could Not Be Found

Greetings,

I have a series of macros, a couple of which access files in a directory. I ran the macros dozens of times yesterday with no issues, but today, I get the "Run Time Error '1004'" file could not be found error in one of the macros. To make it even more bizarre, the program is able to find the directory just fine in the block above the one that is failing. I have spent hours researching this problem, have tried many of the suggestions I have found in various forums, and still can not get it to work. I am absolutely positive that the directory exists, that the path is correct, and that this is not due to a security setting (I copied the folder path directly out of Widows Explorer and, as I stated above, the program is able to access the folder in a previous block of code).

All the code from the start of the program through the Sub that is failing is below.

The failure occurs in "Sub Copy_MostRecent_Data" on the line "Workbooks.Open (drct & fname)"

I would greatly appreciate some help here!

Thanks!

Code:

Function GetFileList(FileSpec As String) As Variant
'   Returns an array of Excel filenames in reports folder
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
NoFilesFound:
    GetFileList = False
End Function

Sub Optimize_Env()
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting
    
    Call Find_Most_Recent_Report
    
End Sub

Sub Find_Most_Recent_Report()
    Dim a As String
    Dim b As Date
    Dim c As String
    Dim fname As String
    Dim drct As String
    drct = "C:\Documents and Settings\All Users\Documents\Reports\March Pulp-Utilities Work Parts Order Lists_New\"
    
    Dim p As String, x As Variant
    p = drct & "*.xlsx"
    x = GetFileList(p)
    
    
    
    For i = LBound(x) To UBound(x)
      If Len(x(i)) > 20 Then
        If Left(x(i), 20) = "March Pulp-Utilities" Then
            If CStr(b) = "" Then
                b = CDate(Split(x(i), " ")(2))
                c = x(i)
            Else:
                If CDate(Split(x(i), " ")(2)) > b Then 'If new date is more recent than previously stored date
                    b = CDate(Split(x(i), " ")(2)) 'Set to more recent date
                    c = x(i)
                ElseIf CDate(Split(x(i), " ")(2)) = b Then 'If 2 files have the same title date
                    
                    ' Last modified file takes precedence
                    If Format(FileDateTime(drct & x(i)), "m/d/yy h:n ampm") > Format(FileDateTime(drct & c), "m/d/yy h:n ampm") Then
                        fname = x(i)
                    Else: fname = c
                    End If
                End If
            End If
        End If
        End If
     Next i
     
     Dim rdate As String
     rdate = Replace(CStr(b), "/", "-")
     
    Call Copy_MostRecent_Data(drct, fname, rdate)
     
    
End Sub


Sub Copy_MostRecent_Data(drct As String, fname As String, rdate As String)
    
    Dim Exists As Boolean
    
    For Each ws In Sheets
        If ws.Name = rdate Then
            Exists = True
            Exit For
        Else: Exists = False
        End If
    Next ws
        
        If Exists = True Then
            MsgBox ("This report already contains the most recent data!")
            Exit Sub
        Else:
        
            ' Open Most Recent Report
         Workbooks.Open (drct & fname)
            Workbooks(fname).Activate
            
            ' Copy "Material Raw Data" sheet and paste into comparison workbook
            Worksheets("Material Raw Data").Select
            Worksheets("Material Raw Data").Copy After:=Workbooks("Parts_Comparison.xlsm").Sheets("Parts_Deleted")
            Workbooks(fname).Close
            
            ' Rename to date of report
            ThisWorkbook.Activate
            Worksheets("Material Raw Data").Name = rdate
            
            ' Copy and Paste Values
            Sheets(rdate).Cells.Values = Sheets(rdate).Cells.Values
            
                    
            ' Remove table formatting
            Dim TableName As String
            Dim oLo As ListObject
            For Each oLo In ActiveSheet.ListObjects
                TableName = oLo.Name
            Next oLo
            ActiveSheet.ListObjects(TableName).Unlist
            
            ' Format column o as text in prep for primary key
            Sheets(rdate).Range("o2").Value = "Order + Material"
            Sheets(rdate).Range("o2").Font.Bold = True
            Sheets(rdate).Range("o2").Formats = Sheets(rdate).Range("m2").Formats
            Sheets(rdate).Range("o:o").NumberFormat = "Text"
            
            ' Add Column for Material combined with Order
            Range("h3").Activate
            Do Until IsEmpty(ActiveCell)
            ActiveCell.Offset(0, 7).Value = (ActiveCell.Offset(0, -7).Value & " " & ActiveCell.Value)
            ActiveCell.Offset(1, 0).Select
            Loop
            
        End If
        
        Call Insert_PT(rdate)
        
End Sub