directory listing

A

akrashid

Hi all,

I want to create a macro that would provide me a listing of a
directory and its sub-directories and create hyperlinks to all
the .pdf files in these dir's. I would like to capture the directory
names too .Also I would like to updates these links everytime the
spreadsheet is opened.
My directory structure is :
c:\Pending Cases
Year_2007
a
b
 
J

Jim Jackson

I got this from another source.

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long


Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean


arfiles = Array()
cnt = -1
level = 1


sFolder = "U:\"
ReDim arfiles(2, 0)
If sFolder <> "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If


Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False


End Sub


'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath


If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If


If sPath = "" Then
sPath = CurDir
End If


arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level


Set oFolder = FSO.GetFolder(sPath)


level = level + 1
If Not sPath Like "*System Volume Information*" Then
For Each oSubFolder In oFolder.subfolders
SelectFiles oSubFolder.Path
Next
End If
level = level - 1


End Sub
 
C

Charles Chickering

Use this code to get you started. If you need help finishing it post back or
email me @ (e-mail address removed).

Sub TestfileSearch()
Dim i As Long
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.Filename = "*.txt"
.LookIn = "C:\Test"
.Execute
For i = 1 To .FoundFiles.Count
ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), _
Address:=.FoundFiles(i) , TextToDisplay:= _
Right(.FoundFiles(i), Len(.FoundFiles(i)) - _
InStrRev(.FoundFiles(i), "\"))
Next
End With
End Sub

Note that I'm using the InStrRev function so this will not work in Excel 97
and previous. (Actually I'm not sure it will work in 2000 either)
 
J

Jim Cone

The free Excel add-in List Files will do all that, except
it will not automatically update (you have to click a couple of buttons).
Download from... http://www.realezsites.com/bus/primitivesoftware
No registration required.
--
Jim Cone
San Francisco, USA



Hi all,
I want to create a macro that would provide me a listing of a
directory and its sub-directories and create hyperlinks to all
the .pdf files in these dir's. I would like to capture the directory
names too .Also I would like to updates these links everytime the
spreadsheet is opened.
My directory structure is :
c:\Pending Cases
Year_2007
a
b
 
A

akrashid

Use this code to get you started. If you need help finishing it post back or
email me @ (e-mail address removed).

Sub TestfileSearch()
Dim i As Long
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.Filename = "*.txt"
.LookIn = "C:\Test"
.Execute
For i = 1 To .FoundFiles.Count
ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), _
Address:=.FoundFiles(i) , TextToDisplay:= _
Right(.FoundFiles(i), Len(.FoundFiles(i)) - _
InStrRev(.FoundFiles(i), "\"))
Next
End With
End Sub

Note that I'm using the InStrRev function so this will not work in Excel 97
and previous. (Actually I'm not sure it will work in 2000 either)
Click to expand...

Charles & Jim,

thanks for the reply. Jim your code is good but is too advanced for my
skill level yet ,I am still taking baby steps. thanks though it will
come in handy in mapping folders and sub folders.

Charles, on your code is there a way I can capture the dir name and
then the hyperlinks will be underaneath each dir name,

thnaks again for all your help.
 
C

Charles Chickering

Try this modification:
Sub TestfileSearch()
Dim i As Long
Dim strFile As String
Dim strFolder As String
Dim strPF As String 'Previous Folder
Dim LineNum As Long
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.Filename = "*.txt"
.LookIn = "C:\Test"
.Execute
If .FoundFiles.Count = 0 Then Exit Sub
strFolder = Left(.FoundFiles(1), InStrRev _
(.FoundFiles(1), "\") - 1)
Range("A1") = strFolder
LineNum = 2
strPF = strFolder
For i = 1 To .FoundFiles.Count
strFile = Right(.FoundFiles(i), Len(.FoundFiles(i)) - _
InStrRev(.FoundFiles(i), "\"))
strFolder = Left(.FoundFiles(i), InStrRev _
(.FoundFiles(i), "\") - 1)
If strFolder = strPF Then
ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & LineNum), _
Address:=.FoundFiles(i), TextToDisplay:=strFile
LineNum = LineNum + 1
Else
Range("A" & LineNum) = strFolder
ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & LineNum + 1), _
Address:=.FoundFiles(i), TextToDisplay:=strFile
LineNum = LineNum + 2
strPF = strFolder
End If
Next
End With
End Sub
 
A

akrashid

Try this modification:
Sub TestfileSearch()
Dim i As Long
Dim strFile As String
Dim strFolder As String
Dim strPF As String 'Previous Folder
Dim LineNum As Long
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.Filename = "*.txt"
.LookIn = "C:\Test"
.Execute
If .FoundFiles.Count = 0 Then Exit Sub
strFolder = Left(.FoundFiles(1), InStrRev _
(.FoundFiles(1), "\") - 1)
Range("A1") = strFolder
LineNum = 2
strPF = strFolder
For i = 1 To .FoundFiles.Count
strFile = Right(.FoundFiles(i), Len(.FoundFiles(i)) - _
InStrRev(.FoundFiles(i), "\"))
strFolder = Left(.FoundFiles(i), InStrRev _
(.FoundFiles(i), "\") - 1)
If strFolder = strPF Then
ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & LineNum), _
Address:=.FoundFiles(i), TextToDisplay:=strFile
LineNum = LineNum + 1
Else
Range("A" & LineNum) = strFolder
ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & LineNum + 1), _
Address:=.FoundFiles(i), TextToDisplay:=strFile
LineNum = LineNum + 2
strPF = strFolder
End If
Next
End With
End Sub
Click to expand...

Charles,

You are the man!! thanks so much that works like a charm. It display
everything I wanted. I have learned a lot in this past week just by
following you guys code.

Thanks for everyone input
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Mail Merge Directory Conditional Page Break 0
list dir contents 0
Update Directory Path in Code 4
XL2007 code not working in XL2103 0
macro listing subfolders from selection of mainfolders 1
Problem with hyperlink macro 0
Macro to Publish as PDF 1
List ALL folders and files 2

Top