VBA change from 2007 to 2016 - failing to open a file and report the sheet contained.

[miless2111s]

I have a macro which worked fine in excel 2007 and now I have upgraded to 2016 when I attempt to run it fails.

Situation:
I have a macro which gathers information on all the excel files in a directory (including sub directories) and can report the worksheets each file contains. This is set by cell "show sheets" being set to Y. If this cell is set to "N" then the files are not opened and the sheets not reported.
If I run the macro in "N" mode it works. If I put "Y" in that cell it now fails. This suggests the following section of code is being handled differently in 2016 compared to 2007:

            If Range("show_sheets") = "N" Then
                all_sheets = "chosen not to display"
            Else
                On Error Resume Next 'sets up the "if there's an error from attempting to open a file someone has opened skip"
                Set wbFnd = Workbooks.Open(fileName:=objFile.Path, UpdateLinks:=False, ReadOnly:=True, Notify:=True)
                If Err.Number <> 0 Then
                    all_sheets = "unable to display sheets as file open by someone else"
                Else
                    For Each wSheet In ActiveWorkbook.Worksheets
                        If all_sheets = "" Then all_sheets = wSheet.Name Else all_sheets = all_sheets & "----" & wSheet.Name
                    Next
                    ActiveWorkbook.Close False
                End If
            End If
            Cells(NextRow, "j").Value = all_sheets
            all_sheets = ""

I cobbled the code together from many sources so it certainly isn't going to be the most elegant When it fails I get a dialogue called "data link properties" which has the tabs "Provider", "Connection", "advanced" and "All". It also tends to leave one of the files open which should have been shut and obviously doesn't get to the end of the macro as not all the data has been displayed.

What do I have to change in my code to get the macro working again (i.e. opening the file, reporting the sheets and then closing the file without saving anything and then moving onto the next one).

Many thanks in advance.

Miles

Full code:

'Force the explicit delcaration of variables
Option Explicit
Sub ListFiles()
' from [url=http://www.xl-central.com/list-the-files-in-a-folder-and-subfolders.html]List the Files in a Folder and SubFolders[/url]
' with heavy edits
     'Set a reference to Microsoft Scripting Runtime by using
     'Tools > References in the Visual Basic Editor (Alt+F11)
     Application.ScreenUpdating = False
     'Application.Calculation = xlCalculationManual
     
     'Declare the variables
     Dim objFSO As Scripting.FileSystemObject
     Dim objTopFolder As Scripting.Folder
     Dim strTopFolderName As String
     Dim wb As Workbook
     Dim ws As Worksheet
     Dim last_row As Long
     
     Set wb = ActiveWorkbook
     Set ws = wb.Sheets("File_listing")
     
     last_row = Cells(Rows.Count, "A").End(xlUp).Row
     ws.Range("A3:K" & last_row).ClearContents
    
     
     'Insert the headers for Columns A through F
     Range("A3").Value = "File Name"
     Range("B3").Value = "File Size"
     Range("C3").Value = "File Type"
     Range("D3").Value = "Date Created"
     Range("E3").Value = "Date Last Accessed"
     Range("F3").Value = "Date Last Modified"
     Range("G3").Value = "Path"
     Range("H3").Value = "Hyperlink"
     Range("i3").Value = "standard sheet A1"
     Range("j3").Value = "Sheets"
     Range("k3").Value = "full path"
     ws.Range("A3:k3").Font.Bold = True
     
     'Assign the top folder to a variable
     strTopFolderName = ws.Range("B1").Value
     
     'Create an instance of the FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     
     'Get the top folder
     Set objTopFolder = objFSO.GetFolder(strTopFolderName)
     
     'Call the RecursiveFolder routine
     Call RecursiveFolder(objTopFolder, True, strTopFolderName)
     
     'Change the width of the columns to achieve the best fit
     Columns.AutoFit
     ws.Columns("i:k").ColumnWidth = 40
     Application.ScreenUpdating = True
     'Application.Calculation = xlCalculationAutomatic
     ws.PivotTables("Latest_versions").RefreshTable
     ws.PivotTables("Latest_version_paths").RefreshTable
     
     Call update_report_sheet
     MsgBox "All updated", 0, "File update macro"
End Sub
Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean, strTopFolderName As String)
     'Declare the variables
     Dim objFile As Scripting.File
     Dim objSubFolder As Scripting.Folder
     Dim NextRow As Long
     Dim pathfolder As String
     Dim Record_wb As Workbook
     Dim Record_ws As Worksheet
     Dim Corrected_file_name As String
              
    
    Dim wbFnd As Workbook
    'Dim FileName As String
    Dim wSheet As Worksheet
    Dim all_sheets As String
    
    
     'Find the next available row
     NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
     
     'Loop through each file in the folder
     For Each objFile In objFolder.Files
     'If Left(objFile.Name, 1) = "~" Then file_name = Right(objFile.Name, Len(objFile.Name) - 1) Else file_name = objFile.Name
     'finds and removes the ~ from the start of any open files
        If Left(objFile.Name, 2) = "~$" Then
            'Next objFile 'do nothing
        Else
            'Corrected_file_name = Replace(objFile.Name, "~$", "")
            Cells(NextRow, "A").Value = objFile.Name 'Corrected_file_name 'was objfile.name
            Cells(NextRow, "B").Value = objFile.Size
            Cells(NextRow, "C").Value = objFile.Type
            Cells(NextRow, "D").Value = objFile.DateCreated
            Cells(NextRow, "E").Value = objFile.DateLastAccessed
            Cells(NextRow, "F").Value = objFile.DateLastModified
            Cells(NextRow, "k").Value = objFile.Path
            pathfolder = Replace(objFile.Path, objFile.Name, "", , , vbTextCompare)
            pathfolder = Replace(pathfolder, strTopFolderName, "", , , vbTextCompare)
            Cells(NextRow, "G").Value = pathfolder
            Cells(NextRow, "H").Value = "=HYPERLINK(""" & objFile.Path & """,""" & "Click Here to Open" & """)"
            Cells(NextRow, "i").Value = "'" & strTopFolderName & pathfolder & "[" & objFile.Name & "]Summary_Report'!A2"
            If Range("show_sheets") = "N" Then
                all_sheets = "chosen not to display"
            Else
                On Error Resume Next 'sets up the "if there's an error from attempting to open a file someone has opened skip"
                Set wbFnd = Workbooks.Open(fileName:=objFile.Path, UpdateLinks:=False, ReadOnly:=True, Notify:=True)
                If Err.Number <> 0 Then
                    all_sheets = "unable to display sheets as file open by someone else"
                Else
                    For Each wSheet In ActiveWorkbook.Worksheets
                        If all_sheets = "" Then all_sheets = wSheet.Name Else all_sheets = all_sheets & "----" & wSheet.Name
                    Next
                    ActiveWorkbook.Close False
                End If
            End If
            Cells(NextRow, "j").Value = all_sheets
            all_sheets = ""
            NextRow = NextRow + 1
        End If
     Next objFile
     
     'Loop through files in the subfolders
     If IncludeSubFolders Then
         For Each objSubFolder In objFolder.SubFolders
             Call RecursiveFolder(objSubFolder, True, strTopFolderName)
         Next objSubFolder
     End If
     
End Sub
Sub update_report_sheet()
Dim latest_version_list As Range
Dim source_ws As Worksheet
Dim wb As Workbook
Dim report_ws As Worksheet
Dim link As String
Dim last_file As Long, last_report_row As Long
Dim i As Integer
Dim Result_1 As String, Result_2 As String, Result_3 As String, Result_4 As String, Result_5 As String, Result_6 As String
'Dim Result_6_no As Long
Dim result_7 As String, result_8 As String, result_9 As String, result_10 As String, result_11 As String
Dim convertor As Range
Dim file_name As String
Set wb = ActiveWorkbook
Set report_ws = wb.Sheets("Report Data")
Set source_ws = wb.Sheets("File_listing")
Set convertor = source_ws.Range("Sheet_2_fileName")
last_report_row = report_ws.Cells(Rows.Count, "A").End(xlUp).Row
report_ws.Range("A1:M" & last_report_row).ClearContents
last_file = source_ws.Cells(Rows.Count, "V").End(xlUp).Row
Set latest_version_list = source_ws.Range("v3,v" & last_file)
report_ws.Range("a1") = "Data Object"
report_ws.Range("b1") = "Source File Name"
report_ws.Range("c1") = "% progress"
report_ws.Range("d1") = "Data points over long"
report_ws.Range("e1") = "Total Data Points"
report_ws.Range("f1") = "Data points completed"
report_ws.Range("g1") = "% sheets manually closed"
report_ws.Range("h1") = "Hyperlink"
report_ws.Range("i1") = "extracted File Name"
report_ws.Range("j1") = "Validation %"
report_ws.Range("k1") = "Records validated"
report_ws.Range("l1") = "% sheets validated"
report_ws.Range("m1") = "Sheet range warning"

report_ws.Range("A1:h1").Font.Bold = True
For i = 4 To last_file '4 as the data in the source listing starts on row 4
    Result_1 = "='" & source_ws.Cells(i, "v").Value 'file name
    Result_2 = Replace(Result_1, "A2", "g2") 'Data Object
    Result_3 = Replace(Result_1, "A2", "i2") 'average progress
    Result_4 = Replace(Result_1, "A2", "j2") 'cells over length
    Result_5 = Replace(Result_1, "A2", "m2") 'total data points
    Result_6 = Replace(Result_1, "A2", "n2")  'data points completed (calculated)
    result_7 = Replace(Result_1, "A2", "o2") 'check for manual closure of object
    file_name = WorksheetFunction.VLookup(source_ws.Cells(i, "v").Value, convertor, 3, False)
    result_8 = Replace(Result_1, "A2", "p2") 'validation %
    result_9 = Replace(Result_1, "A2", "q2") 'records validated
    result_10 = Replace(Result_1, "A2", "r2") '% sheets validated
    result_11 = Replace(Result_1, "A2", "s2") 'sheets need more rows in calculation warning
    
    
    report_ws.Range("a" & i - 2).Value = Result_2 '-2 to adjust up to start at the top of the page
    report_ws.Range("b" & i - 2).Value = Result_1
    report_ws.Range("c" & i - 2).Value = Result_3
    report_ws.Range("d" & i - 2).Value = Result_4
    report_ws.Range("e" & i - 2).Value = Result_5
    report_ws.Range("f" & i - 2).Value = Result_6
    report_ws.Range("g" & i - 2).Value = result_7
    report_ws.Range("h" & i - 2).Value = "=HYPERLINK(""" & file_name & """,""" & "Click Here to Open" & """)"
    report_ws.Range("i" & i - 2).Value = "=MID(B" & i - 2 & ",FIND(""["",B" & i - 2 & ")+1,FIND(""]"",B" & i - 2 & ")-FIND(""["",B" & i - 2 & ")-1)"
    report_ws.Range("j" & i - 2).Value = result_8
    report_ws.Range("k" & i - 2).Value = result_9
    report_ws.Range("l" & i - 2).Value = result_10
    report_ws.Range("m" & i - 2).Value = result_11
    
    
Next i
report_ws.Range("C:C").NumberFormat = "#,#0.00%"
report_ws.Range("g:g").NumberFormat = "#,#0.00%"
report_ws.Range("J:J").NumberFormat = "#,#0%"
report_ws.Range("L:L").NumberFormat = "#,#0%"
report_ws.Range("D:F").NumberFormat = "#,###"
report_ws.Columns.AutoFit
End Sub

 

[miless2111s]

Anyone?