Hyperlink List of Files in Folder

erock24

Well-known Member
Joined
Oct 26, 2006
Messages
1,160
I found the following code that creates a hyperlinked list of all files in a folder. How can the code be edited to also bring back properties of the file. I would like to see dates: created, last modified, last accessed.

Code:
Sub HyperlinkXLSFiles()
Dim lCount As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

    With Application.FileSearch
        .NewSearch
         'Change path to suit
        .LookIn = "C:\MyDocuments\Testings"
        .FileType = msoFileTypeExcelWorkbooks
       ' .Filename = "Book*.xls"
        
            If .Execute > 0 Then 'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count 'Loop through all.
                    ActiveSheet.Hyperlinks.Add Anchor:=Cells(lCount, 1), Address:= _
                    .FoundFiles(lCount), TextToDisplay:= _
                     Replace(.FoundFiles(lCount), "C:\MyDocuments\Testings\", "")
                 Next lCount
            End If
    End With
    
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

erock24

Well-known Member
Joined
Oct 26, 2006
Messages
1,160
That is previous thread of mine. It is not a hyperlinked list however. I need a macro that can list all the files of a folder and the files date properties and the list needs to be hyperlinked.

Thank you.
 

Kath

New Member
Joined
Sep 15, 2008
Messages
7
Hello erock24. *Bumps thread* I see you are an active member here & was trying to send this while you were online just now but missed you!:)

You may have seen I have an identical requirement in my thread http://www.mrexcel.com/forum/showthread.php?t=341608&highlight=hyperlinked

though I don't need the detailed date properties. I'm really surprised this doesn't come up more often - eg name, rank, number...photo! I suppose the assumption is that a full-on database is required.

Have you had any luck with this? kgkev solved mine, but without using code (phew, as I have no idea about code). There is still some manual intervention required, so as a user I'd love to see a macro/code solution without needing to understand how it is done behind the scenes.

The dos code:

dir C:\Testimages /T:A >C:\Testimageslist.xls

would give you the unhyperlinked list of file names and - in this example - access dates in an Excel spreadsheet (and some other junk you'd need to edit out), but I could only get creation date [/T:C] and modified date [/T:W] as alternatives rather than outputting all three together.

You could then bulk hyperlink them using kgkev's method.

So there is a non-code way to do it, but laborious and not justified unless you have millions of files (like I do!:biggrin:).

Anyway, interested to hear if there's any news on this!
 
Last edited:

erock24

Well-known Member
Joined
Oct 26, 2006
Messages
1,160
Well, I received the following code that will search a folder and create a hyperlinked list of all it's contents with some file attributes as well. I tweaked it a little to also bring back specific cell data on the sheets.

Code:
Sub MISCFile_Listing()
'Standard module code, like: Module1.
Dim objFileScript As Object, objFolder As Object, objThisFile As Object, objThisFolder
Dim strFileCreate$, strFileAccess$, strFileDtMod$, strAttrNm$
Dim strFileNm$, strFileType$, strFileAttr$, strFilePath$
Dim dubFileSize#
Dim lngAttr&

'strFolderNm = CurDir
On Error Resume Next
Columns("B:C").Columns.Ungroup
ActiveSheet.Cells.Delete

ActiveSheet.Range("A4").Value = "Folder"
ActiveSheet.Range("b4").Value = "Name.Ext"
ActiveSheet.Range("c4").Value = "Author"
ActiveSheet.Range("d4").Value = "Lines"
ActiveSheet.Range("e4").Value = "Amount"
ActiveSheet.Range("f4").Value = "Year"
ActiveSheet.Range("g4").Value = "Create Date"
ActiveSheet.Range("H4").Value = "Last Modified"
ActiveSheet.Range("I4").Value = "Size"
ActiveSheet.Range("J4").Value = "Units"
ActiveSheet.Range("K4").Value = "Type"
ActiveSheet.Range("L4").Value = "Attribute"
ActiveSheet.Range("A4:L4").Font.Bold = True
 
Set objFileScript = CreateObject("Scripting.FileSystemObject")
'Change Path as Needed
Set objFolder = objFileScript.GetFolder("Y:\Budget\2009\Manual Sheets\Manual Sheets\Plant Projects & MISC\Posted")
Set objThisFolder = objFolder.Files
 
For Each objThisFile In objThisFolder
strFilePath = objThisFile.Path
strFileNm = objThisFile.Name
dubFileSize = objThisFile.Size
strFileType = objThisFile.Type
strFileCreate = objThisFile.DateCreated
strFileAccess = objThisFile.DateLastAccessed
strFileDtMod = objThisFile.DateLastModified
strAttrNm = ""
lngAttr = 0
lngAttr = objThisFile.Attributes
 
If lngAttr = 0 Then
strAttrNm = strAttrNm & "Normal"
ElseIf lngAttr = 16 Then
strAttrNm = strAttrNm & "Directory "
ElseIf lngAttr = 1 Then
strAttrNm = strAttrNm & "Read-Only "
ElseIf lngAttr = 2 Then
strAttrNm = strAttrNm & "Hidden "
ElseIf lngAttr = 4 Then
strAttrNm = strAttrNm & "Normal System "
ElseIf lngAttr = 8 Then
strAttrNm = strAttrNm & "Volume "
ElseIf lngAttr = 32 Then
strAttrNm = strAttrNm & "Archive "
ElseIf lngAttr = 1024 Then
strAttrNm = strAttrNm & "Alias "
ElseIf lngAttr = 2048 Then
strAttrNm = strAttrNm & "Compressed "
Else

strAttrNm = strAttrNm & "Hidden System "
End If
 
strFileAttr = strAttrNm
ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
Selection.Value = strFilePath
Selection.Offset(0, 1).Value = strFileNm
Selection.Offset(0, 2).Formula = "='" _
    & Left(strFilePath, InStrRev(strFilePath, Application.PathSeparator)) _
    & "[" & strFileNm & "]BUDGET'!$N$2"
Selection.Offset(0, 3).Formula = "='" _
    & Left(strFilePath, InStrRev(strFilePath, Application.PathSeparator)) _
    & "[" & strFileNm & "]BUDGET'!$C$2"
Selection.Offset(0, 4).Formula = "='" _
    & Left(strFilePath, InStrRev(strFilePath, Application.PathSeparator)) _
    & "[" & strFileNm & "]BUDGET'!$V$3"
Selection.Offset(0, 5).Formula = "='" _
    & Left(strFilePath, InStrRev(strFilePath, Application.PathSeparator)) _
    & "[" & strFileNm & "]BUDGET'!$C$3"
Selection.Offset(0, 6).Value = strFileCreate
Selection.Offset(0, 7).Value = strFileDtMod
Selection.Offset(0, 8).Value = Format(dubFileSize, "###,###,###")
Selection.Offset(0, 9).Value = " Bytes"
Selection.Offset(0, 10).Value = strFileType
Selection.Offset(0, 11).Value = strFileAttr
On Error Resume Next
Next objThisFile
Columns("A:m").Columns.AutoFit
Columns("A:A").Insert Shift:=xlToRight
Range("A4").FormulaR1C1 = "File Name - Link"
Range("A4").Font.Bold = True
Range("A5").FormulaR1C1 = "=HYPERLINK(RC2,RC3)"
On Error Resume Next
Range("A5").AutoFill Destination:=Range("A5:A" & Range("B" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
 Columns("B:C").Columns.Group
 ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
With ActiveSheet.Range("A1")
.Value = "Posted Manual Sheet Inventory - Plant Projects & MISC"
.Font.Bold = True
End With
With ActiveSheet.Range("A2")
.FormulaR1C1 = "As of " & Date
.Font.Bold = True
End With
Columns("A:A").Columns.AutoFit
With Range("A4:M4")
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlDouble
End With
With Columns("D:G")
    .Value = .Value
End With
Columns("F:F").NumberFormat = "#,##0_);[Red](#,##0)"
Columns("E:E").HorizontalAlignment = xlCenter
Columns("G:G").NumberFormat = "0_);(0)"
Columns("H:I").NumberFormat = "mm/dd/yy;@"
Columns("J:J").NumberFormat = "#,##0_);[Red](#,##0)"
Dim rng2 As Range
Dim lastrow As Long
Dim cc As Range
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set rng2 = Range(Cells(5, 4), Cells(lastrow, 7))
For Each cc In rng2
If cc.Value = "#REF!" Or cc.Value = "0" Then cc.Value = ""
Next cc
    
Application.Goto reference:="R1C1"
MsgBox ("MISC Inventory Complete")
End Sub
 

Kath

New Member
Joined
Sep 15, 2008
Messages
7
Woah thanks for the speedy reply, erock24!

Give me a while to see how to use it & what it does, and I'll report back accordingly!:)
 

Watch MrExcel Video

Forum statistics

Threads
1,123,487
Messages
5,601,970
Members
414,487
Latest member
inxlsplot

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
Top