Results 1 to 8 of 8

Thread: Help with hyperlinking files in subdirectories to a list of filenames in another work

  1. #1

    Smile Help with hyperlinking files in subdirectories to a list of filenames in another work



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi,

    I need help with this. I have asked for help in other forums but I still do not have a working solution. I am a novice, so please be generous with your suggestions.

    I have a file, INVLog which has invoice numbers recorded in column A in the format of "100021", "100059" etc with corresponding files in the subdirectories of a directory INVARCHIVE. I am attaching below the INVLog file I created for testing.

    The INVARCHIVE directory contains subdirectories SX5021, SS4286, SS4250 and subdirectory SX5021 contaisn files 100021.xls and 100023.xls ... and so on

    The following code works for me if all teh files were in the main folder and not in various subfolders within the INVARCHIVE main directoryr.

    Option Explicit

    Sub Hyperlink()
    Dim lastRow As Long
    Dim folderPath As String
    Dim cell As Range
    Dim i As Long

    folderPath = "C:\Users\Talāt\Desktop\INVARCHIVE\"
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 1 To lastRow
    Range("A" & i).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=folderPath & Cells(i, 1) & ".xls"
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleNone
    Selection.Font.ColorIndex = 5

    Next i
    MsgBox "Linking is complete."
    End Sub

    I need the code adapted so that it will do exactly what the above code does, EXCEPT that it looks in all the subfolders inside the Main INVARCHIVE folder to find teh relevant files to hyperlink to.

    Both the INVLog files and the INVARCHIVE contents are added to continously, and are growing. So I would need to run teh code to hyperlink teh newly added files from time to time. Apart from hyperlinking the file names in teh INVLog to teh actual files in teh subdirectories, I do not want any otehr changes made to the files.

    The final code will reside in teh INVLog file and be run from there.

    Thanks for any help you can give me with this. :-)

    Talāt
    Attached Files Attached Files

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,090
    Articles
    79
    Blog Entries
    14
    I have asked for help in other forums but I still do not have a working solution
    I appreciate you being up front with this, but can you post some links to the other forums? If the question is being actively worked on, it makes sense for someone to chime into those posts, not here.
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3
    Thanks but I need a fresh look into it. I had two people replying on the other forums. One did not understand what exactly was needed, and the other responder built her contribution entirely on the back of the first one. That is why I changed forums, so that I can get a fresh perspective to it.

    Like I said, if all the excell files were in the same directory, I have a code that works, and I don't need any help. However, the target files are in different sub directories within one main directory, and its the solution to this that I need. A fresh pair of eyes is what I need.

    Thanks.

  4. #4
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,090
    Articles
    79
    Blog Entries
    14
    Okay, so basically what you're saying here is that you want to:
    • Provide the top level folder in the hierarchy
    • Have the routine search through the folder and it's subfolders looking for the file
    • Hyperlink the filename to it's file path
    Is that correct?

    So questions I'd want to know up front:
    • How many subfolders are we looking at here... 10, 20, 30?
    • Do we need to take into account nested subfolders? How many levels deep could the file be? 1, 2, ?
    I'm just concerned that building a routine could be slow depending on how many passes we need to make here. If there's lots, then we may want to look at reading all files in the directory into a list first, then culling out the ones that aren't needed, rather than going back throug a loop over and over again.

    I will certainly help you with this, but I'd also appreciate two things:
    • Let the others know that you are having this looked at elsewhere so they don't waste their time on it.
    • Post here to let me know if you get an answer before I've completed one, so that I don't waste my time.
    Fair enough?
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  5. #5
    Hi Ken,

    Yes. Fair do!

    I will answer your questions one by one.

    * Yes, your understanding is correct.

    * At the moment there are are about 20 folders, but this can increase to about 60 or just over, but over time my guess is that it will never be more than about 80, and probably much less. Say somewhere between 60-70 at most.

    * No nested folders and hence no levels. Just the 60 to 65 subfolders containing teh excel files within the INVARCHIVE directory.

    I undertake to let the others know that someone is looking at it now and let you know if anyone from another forum makes a contribution. I have to say though that his is unlikely as responses have died down now.

    Below, I am pasting the solution from Lisa Green, which was the last contribution.


    Option Explicit
    Sub subHLinkFiles()
    ' Assume files exist.
    ' Create two filename arrays.
    ' One array will have just the file names.
    ' The other will have the full path.
    Dim slFullFileNames() As String
    Dim slFileNames() As String
    ReDim Preserve slFullFileNames(0)
    ReDim Preserve slFileNames(0)
    ' This is a record of the Top file and the file type looked for.
    slFullFileNames(0) = "C:\Users\Talāt\Desktop\INVARCHIVE\"
    slFileNames(0) = "XLS"
    subGetFileNames _
    slFullFileNames(), _
    slFileNames()
    Stop
    ' *********************************************************************
    End Sub
    Sub subGetFileNames( _
    spFullFileNames() As String, _
    spFileNames() As String)

    Dim flslFile As File
    Dim flslFiles As Files
    Dim follFolder As Folder
    Dim follSubFolder As Folder
    Dim olFS As FileSystemObject
    Dim slExt As String
    Dim slFile As String
    Dim slFileName As String
    Dim slFolder As String
    Dim slShortFileName As String

    slFolder = spFullFileNames(0)
    Set olFS = CreateObject("Scripting.FileSystemObject")
    Set follFolder = olFS.GetFolder(slFolder)
    Set flslFiles = follFolder.Files
    slExt = UCase(spFileNames(0))
    For Each flslFile In flslFiles
    slFileName = flslFile.Name

    'Correct EXT?
    If slExt = UCase(olFS.GetExtensionName(slFileName)) Then

    ' Strip the EXT.
    slExt = "." & slExt
    slShortFileName = Replace(UCase((slFileName)), slExt, "")

    ' Add to Arrays.
    ReDim Preserve spFullFileNames(UBound(spFullFileNames) + 1)
    spFullFileNames(UBound(spFullFileNames)) = slFolder & "\" & slFileName

    ReDim Preserve spFileNames(UBound(spFileNames) + 1)
    spFileNames(UBound(spFileNames)) = slShortFileName

    End If
    Next flslFile
    For Each follSubFolder In follFolder.SubFolders
    spFullFileNames(0) = follSubFolder.Path
    subGetFileNames spFullFileNames, spFileNames
    Next follSubFolder
    ' *********************************************************************
    End Sub

    And here is the link to the post

    http://www.thecodecage.com/forumz/mi...post1054991233


    Thanks for agreeing to help me on this.

    Talāt
    Last edited by Talat; 2011-10-05 at 08:27 PM.

  6. #6
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,090
    Articles
    79
    Blog Entries
    14
    Hi Talat,

    You had some good people working on it over there. Simon, in particular, works really hard at trying to make things right. I'm sure if you'd mentioned the issues he would have fixed you up.

    At any rate, here's the code that should do what you need. I wrote this from scratch, so it probably won't bare any resemblance to what you had. The way it works is this:
    • The folder and worksheet names you'd need to tweak are at the top of the "HyperlinkFileList" routine
    • That routine clears out any existing hyperlinks, as when you update you'll want to make sure all links are still valid
    • It then creates a temporary sheet to hold a table of file paths to the indivdual files in the specified folder and subfolders
    • The table is populated by calling the "ListFolderContent" routine. This procedure kicks off a recursive process, which essentially means it keeps calling itself and listing all files in every level of subfolder. So even if you do nest a bunch of subfolders, it will check them all.
    • It then defines a name for the table so it can easily be referred to using a VLOOKUP call
    • Next it cycles through all the records in Sheet1, looks up the file path and hyperlinks it if found. (If not, it just leaves the file unlinked)
    • Finally it cleans up by deleting the named range and table
    The code is as follows:
    Code:
    Option Explicit
    Sub HyperlinkFileList()
    'Macro purpose:  To apply hyperlinks to files found in main folder or subfolders
        Dim wsSource As Worksheet
        Dim wsWriteResultsTo As Worksheet
        Dim rngToExamine As Range
        Dim cl As Range
        Dim sHyperlinkPath As String
        Dim sStartingFolder As String
        
        'Define folder to start with
        sStartingFolder = "C:\Users\Talāt\Desktop\INVARCHIVE\"
        'Define the range to Hyperlink
        Set wsSource = Worksheets("Sheet1")
        With wsSource
            Set rngToExamine = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
        End With
        'Turn off screen updates to improve speed and prevent flashing
        Application.ScreenUpdating = False
        'Clear all existing Hyperlinks
        wsSource.Cells.Hyperlinks.Delete
        'Make sure a worksheet to hold the listing exists
        On Error Resume Next
        Set wsWriteResultsTo = Worksheets("DirListing")
        If Err.Number <> 0 Then
            'Worksheet does not exist, so create it
            Set wsWriteResultsTo = Worksheets.Add
            wsWriteResultsTo.Name = "DirListing"
        Else
            'Worksheet exists, so clear contents
            wsWriteResultsTo.Cells.ClearContents
        End If
        On Error GoTo 0
        'Set up the headers on the worksheet
        With wsWriteResultsTo
            With .Range("A1")
                .Value = "File name"
                .ColumnWidth = 20
            End With
            With .Range("B1")
                .Value = "File path"
                .ColumnWidth = 50
            End With
        End With
        'Retrieve the list of files in folder below (plus any subfolder)
        Call ListFolderContent(sStartingFolder, wsWriteResultsTo)
        'Add named range for lookups
        With wsWriteResultsTo
            ActiveWorkbook.Names.Add Name:="tblFileNames", RefersToR1C1:= _
                                     .Range("A1:B" & .Range("A" & wsWriteResultsTo.Rows.Count).End(xlUp).Row)
        End With
        'Add hyperlinks
        For Each cl In rngToExamine
            'Retrieve Hyperlink File Path
            On Error Resume Next
            sHyperlinkPath = CStr(Application.WorksheetFunction.VLookup(cl.Value, Range("tblFileNames"), 2, False))
            If Err.Number <> 0 Then sHyperlinkPath = "#N/A"
            On Error GoTo 0
            'Check and make sure the file path exists
            If sHyperlinkPath = "#N/A" Then
                'No file found.  Ignore
            Else
                'File located, insert hyperlink
                'If Excel 2000 or greater, add hyperlink with file name
                'displayed.  If earlier, add hyperlink with full path displayed
                If Val(Application.Version) > 8 Then    'Using XL2000+
                    wsSource.Hyperlinks.Add _
                            Anchor:=cl, _
                            Address:=sHyperlinkPath, _
                            TextToDisplay:=sHyperlinkPath
                Else    'Using XL97
                    wsSource.Hyperlinks.Add _
                            Anchor:=cl, _
                            Address:=sHyperlinkPath
                End If
            End If
        Next cl
        
        'Remove the temporary worksheet and range name
        Application.DisplayAlerts = False
        wsWriteResultsTo.Delete
        Application.DisplayAlerts = True
        ActiveWorkbook.Names("tblFileNames").Delete
    End Sub
    Sub ListFolderContent(sDirectory As String, wsTarget As Worksheet)
    'Macro purpose:  To create a list of all files in a directory
        Dim fso As Object
        Dim File As Object
        Dim Folder As Object
        Dim SubFolder As Object
        Dim rngTarget As Range
        'Turn off screen flashing
        Application.ScreenUpdating = False
        'Create objects to get a listing of all files in the directory
        Set fso = CreateObject("Scripting.FileSystemObject")
        'Get list of files to list
        Set Folder = fso.GetFolder(sDirectory)
        'Adds each file to the list
        For Each File In Folder.Files
            If InStr(1, LCase(File.Path), ".xls") Then
                With wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Offset(1, 0)
                    .Value = CStr(Left(File.Name, InStr(1, LCase(File.Name), ".xls") - 1))
                    .Offset(0, 1).Value = File.Path
                End With
            End If
        Next
        'Check each subfolder for files that should be added
        For Each SubFolder In Folder.SubFolders
            Call ListFolderContent(SubFolder.Path, wsTarget)
        Next SubFolder
    End Sub
    I've also attached a workbook with the code embedded. It is in Module2.

    If I've missed anything, let me know and we'll get it tweaked. I think this should do it for you though.
    Attached Files Attached Files
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  7. #7
    Hi Ken,

    Many thanks. I have tested this now on the live data and all is well. It does exactly what I need it to do. I am really grateful to you for taking this on and doing it so quickly as well. Simon and Lisa were also good to me and I have thanked them. I have learnt new things about VBA coding from Lisa which I had no notion of previously, so it has been a good useful experience for me even though my origional brief was not understood correctly.

    Thank you very much , again.

    Talāt

  8. #8
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,090
    Articles
    79
    Blog Entries
    14
    No problem Talāt, I'm glad it worked.

    Just for reference (ha!), I know Lisa had you set a reference to the Microsoft Scripting Runtime library. This was necessary as she was using Early Binding to the FSO model to accomplish her approach. I've used a Late Binding approach, as this makes the code a bit more portable across systems with different versions. Net effect is that you can uncheck that reference in VBE->Tools->References as Late Binding doesn't require it.

    CHeers,
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •