Thanks Thanks:  0
Likes Likes:  0
Results 1 to 6 of 6

Thread: VBA trapping an error when setting up link to another workbook

  1. #1
    Board Regular
    Join Date
    Feb 2016
    Posts
    243
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA trapping an error when setting up link to another workbook

    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

  2. #2
    Board Regular
    Join Date
    Feb 2016
    Posts
    243
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA trapping an error when setting up link to another workbook

    Quote Originally Posted by miless2111s View Post
    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?

  3. #3
    Board Regular
    Join Date
    Feb 2016
    Posts
    243
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA trapping an error when setting up link to another workbook

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

    TIA

    Miles

  4. #4
    Board Regular
    Join Date
    Jul 2012
    Location
    Hampshire, UK
    Posts
    3,680
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA trapping an error when setting up link to another workbook

    Quote Originally Posted by miless2111s View Post
    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

  5. #5
    Board Regular
    Join Date
    Feb 2016
    Posts
    243
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA trapping an error when setting up link to another workbook

    Quote Originally Posted by dmt32 View Post
    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

  6. #6
    Board Regular
    Join Date
    Feb 2016
    Posts
    243
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA trapping an error when setting up link to another workbook

    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

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
This website uses cookies
We use cookies to store session information to facilitate remembering your login information, to allow you to save website preferences, to personalise content and ads, to provide social media features and to analyse our traffic. We also share information about your use of our site with our social media, advertising and analytics partners.
     


DMCA.com