Auto import list of hyperlinked filenames from directory

[kylee]

Hi y'all,
I'm not finding an answer on this one, either through this forums search or through Google search. It's probably due to the way I'm wording it, but I don't know how else to say what I want.

I have a master claims file, subfolders x3, and many, many files in each subfolder. There are several files added daily, so the directories change. I want to import a hyperlinked list of all filenames located in My Documents/Claims. That's easy enough (because I'm using ASAP add-in utility), but I'd like to have it done automatically on open. When I open my claims log, I would like the current "Sheet1" deleted and a new "Sheet1" imported listing all filenames within the directory.

There are 1000's of files, and when I am looking for 1 in particular, it is SOOO much easier to just open Sheet1, ctrl-F, type in a few characters of the serial number and click the hyperlink- rather than trying to find the exact sequence of characters in a sea of them.

I am already using a SaveCopy on close vba thingie in ThisWorkbook, so if the answer to this question is VBA, that'll have to be considered.

Thank you in advance, you'll never know how much y'all have helped me in the past!
~Ky

 

[DippNCope]

I use this. it lets you pick the directory you want

Sub HyperlinkFileList()
     'Macro purpose:  To create a hyperlinked list of all files in a user
     'specified directory, including file size and date last modified
     'NOTE:  The 'TextToDisplay' property (of the Hyperlink object) was added
     'in Excel 2000.  This code tests the Excel version and does not use the
     'Texttodisplay property if using XL 97.
     
    Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean, _
    ExcelVer As Integer
     
     'Turn off screen flashing
    Application.ScreenUpdating = False
     
     'Create objects to get a listing of all files in the directory
    Set fso = CreateObject("Scripting.FileSystemObject")
     
     'Prompt user to select a directory
    Do
        Problem = False
        Set ShellApp = CreateObject("Shell.Application"). _
        Browseforfolder(0, "Please choose a folder", 0, "c:\\")
         
        On Error Resume Next
         'Evaluate if directory is valid
        Directory = ShellApp.self.Path
        Set SubFolder = fso.GetFolder(Directory).Files
        If Err.Number <> 0 Then
            If MsgBox("You did not choose a valid directory!" & vbCrLf & _
            "Would you like to try again?", vbYesNoCancel, _
            "Directory Required") <> vbYes Then Exit Sub
            Problem = True
        End If
        On Error GoTo 0
    Loop Until Problem = False
     
     'Set up the headers on the worksheet
    With ActiveSheet
        With .Range("A1")
            .Value = "Listing of all files in:"
            .ColumnWidth = 40
             '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+
                .Parent.Hyperlinks.Add _
                Anchor:=.Offset(0, 1), _
                Address:=Directory, _
                TextToDisplay:=Directory
            Else 'Using XL97
                .Parent.Hyperlinks.Add _
                Anchor:=.Offset(0, 1), _
                Address:=Directory
            End If
        End With
        With .Range("A2")
            .Value = "File Name"
            .Interior.ColorIndex = 15
            With .Offset(0, 1)
                .ColumnWidth = 15
                .Value = "Date Modified"
                .Interior.ColorIndex = 15
                .HorizontalAlignment = xlCenter
            End With
            With .Offset(0, 2)
                .ColumnWidth = 15
                .Value = "File Size (Kb)"
                .Interior.ColorIndex = 15
                .HorizontalAlignment = xlCenter
            End With
        End With
    End With
     
     'Adds each file, details and hyperlinks to the list
    For Each File In SubFolder
        If Not Excludes(Right(File.Path, 3)) = True Then
            With ActiveSheet
                 '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+
                    .Hyperlinks.Add _
                    Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                    Address:=File.Path, _
                    TextToDisplay:=File.Name
                Else 'Using XL97
                    .Hyperlinks.Add _
                    Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                    Address:=File.Path
                End If
                 'Add date last modified, and size in KB
                With .Range("A65536").End(xlUp)
                    .Offset(0, 1) = File.datelastModified
                    With .Offset(0, 2)
                        .Value = WorksheetFunction.Round(File.Size / 1024, 1)
                        .NumberFormat = "#,##0.0"
                    End With
                End With
            End With
        End If
    Next
     
End Sub

 

[kylee]

DippNCope,
Thank you for your reply. Unfortunately, nothing happens when I copy/paste the code. I have tried everything that I know to do, but that knowledge is VERY limited when it comes to VBA, so I'm stuck.

The files that I need are in My Docs/Claims/then 4 subfolders (BoS, Pending, RA Rec'd, Completed) w/files. I'd like the WB to automatically insert a worksheet, and import a hyperlinked list of all those files onto that new worksheet every time I open the WB.

To troubleshoot, when I say nothing happens, I mean nothing. lol, there is no difference in my WB/WS, no new sheet is imported, no message saying something didn't work - just nuttin.

I look forward to any new replies ...
Thanks again!
~Ky