VBA trapping an error when setting up link to another workbook

miless2111s

Active Member
Joined
Feb 10, 2016
Messages
279
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a macro which cycles through all the files in a directory and gathers various pieces of information. It then sets up some links to a specific sheet to allow it to gather updates to values in these cells. It all works very nicely however I would like to make it a little slicker by solving one issue:

Some of the workbooks have not yet had the standard sheet set up within them (worksheet = "Summary_Report") and in this case excel asks which sheet it should use instead. I would like to be able to trap this situation and not attempt to set up the linkage if the Summary_Report sheet doesn't exist.

How can I do this?

Many thanks

Miles
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
I have a macro which cycles through all the files in a directory and gathers various pieces of information. It then sets up some links to a specific sheet to allow it to gather updates to values in these cells. It all works very nicely however I would like to make it a little slicker by solving one issue:

Some of the workbooks have not yet had the standard sheet set up within them (worksheet = "Summary_Report") and in this case excel asks which sheet it should use instead. I would like to be able to trap this situation and not attempt to set up the linkage if the Summary_Report sheet doesn't exist.

How can I do this?

Many thanks

Miles
no one? :(
 
Upvote 0
Have I not given enough info? This would be the first time that this site has failed to come back with anything! :(

TIA

Miles
 
Upvote 0
Have I not given enough info? This would be the first time that this site has failed to come back with anything! :(

TIA

Miles

Hi,
Have to remember this is a voluntary site & contributors give their time freely when they are able – sometimes you will get almost instant responses other times, may have to wait awhile.

One thing that would help would be to share the macro you want to improve – someone here may be able to offer suggestions to change it for you.

Hope helpful

Dave
 
Upvote 0
Hi,
Have to remember this is a voluntary site & contributors give their time freely when they are able – sometimes you will get almost instant responses other times, may have to wait awhile.

One thing that would help would be to share the macro you want to improve – someone here may be able to offer suggestions to change it for you.

Hope helpful

Dave

Dave
I fully understand that and it make this place even more awesome! I will share my macro(s) as soon as the report has stopped running.
Regards
Miles
 
Upvote 0
Here is the macro.
Code:
'Force the explicit delcaration of variablesOption Explicit


Sub ListFiles()


' from http://www.xl-central.com/list-the-files-in-a-folder-and-subfolders.html
' 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
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
     Corrected_file_name = Replace(objFile.Name, "~$", "")
        Cells(NextRow, "A").Value = 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"
        
        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
        Cells(NextRow, "j").Value = all_sheets
        all_sheets = ""
        NextRow = NextRow + 1
     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
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:F" & 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("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)
    


    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)"
Next i
report_ws.Range("C:C").NumberFormat = "#,#0.00%"
report_ws.Range("g:g").NumberFormat = "#,#0.00%"
report_ws.Range("D:F").NumberFormat = "#,###"
report_ws.Columns.AutoFit
End Sub

The section I want to chose to run or not is the last line in the sub list_files - where the sub routine update report sheet is called. If it can't find "summary_report" sheet in the file it shouldn't run the reporting routine as that needs to be able to find the relevant worksheet.

Hopefully this helps someone :)

TIA

Miles
 
Upvote 0

Forum statistics

Threads
1,213,501
Messages
6,114,010
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top