Solved: Browse A Folder And Hyperlink All Modified WBs

[lucas]

Johnske walks you through it here
Also remember that you don't have to send it in for approval without working on it as long as you like. You control it's status as "work in progress" until you get it the way you like it and then you submit it.

[Wolfgang]

Hi Cal...

apologies for having to bother you again, but would it be possible to have the option to include the top-folder into the search as well?

Reason: I got a folder named "MY-TOOLS" with plenty of .xls files in there plus some 20 subfolders...
It would be nice to be able to list those residing in the main folder too...

Thank you...

Wolfgang

[CBrine]

Wolfgang,
I'm not sure that I can set it up to go into sub folders, but I should be able to set it up for selecting multiple folders. Let me do a little research on the sub-folders bit first. If I'm not able to come up with a solution for that I will modify the code to work with multiple folders, which should make things a little easier as long as you don't have to many sub levels.

Cal

[Wolfgang]

Good Morning Cal...

Sorry for not being too clear on my side...

I only want to be able to list what is saved under the "Main-Folder", in my case, folder "MY-TOOLS" which does contain subfolders which I can select as I like according to your code...

Since I also save .xls files in the Main-Folder from time to time I like to list those as well...

I sure have a strange kind of humor but am not always able to express myself clearly...

Best,
Wolfgang
(and thank you very much for your time)

[CBrine]

Wolfgang,
It wasn't as difficult as I thought it would be.

Give this a try.

[vba]
Sub GetModifiedFiles()
Dim f As Object, fso As Object, flder As Object
Dim folder As String
Dim wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
End
End If
folder = .SelectedItems(1)
End With
For Each flder In fso.GetFolder(folder).SubFolders
For Each f In fso.GetFolder(flder.Path).Files
If f.DateLastModified > Now() - 7 And f.Type = "Microsoft Excel Worksheet" Then
ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) = "=hyperlink(""" & f.Path & """,""" & f.ShortName & """)"
End If
Next
Next
For Each f In fso.GetFolder(folder).Files
If f.DateLastModified > Now() - 7 And f.Type = "Microsoft Excel Worksheet" Then
ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) = "=hyperlink(""" & f.Path & """,""" & f.ShortName & """)"
End If
Next

End Sub
[/vba]

HTH
Cal

[Wolfgang]

Hi Cal...

I have this one folder "MY-TOOLS" which contains sub-folders which I named according to the individual solutions and normally keep updated...

sometimes I forget to move the .xls files from MY-TOOLS to the respective sub-folders and I would like to have those included in the file search...

I know this could be achieved easylie by getting better organized...maybe I will just do that, rather than to give you a hard time with my ranting...

So, please consider this "case closed" as it already shows and thank you very much again...

...just help yourself to another fine beer on me...

Best,
Wolfgang

[Wolfgang]

Good Morning Cal...

by "modified" I just mean to be abe to set a certain time frame like "Today Minus 7 Or 6 Or 10" for example for all sub-folders plus the top-folder...

Best,
Wolfgang

[CBrine]

This code will prompt you to enter the number of days you want to go back.
[VBA]
Sub GetModifiedFiles()
Dim f As Object, fso As Object, flder As Object
Dim folder As String, NumberOfDays as Integer
Dim wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook Set ws = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
NumberOfDays=InputBox("Enter NumberOfDays")

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
End
End If
folder = .SelectedItems(1)
End With
For Each flder In fso.GetFolder(folder).SubFolders
For Each f In fso.GetFolder(flder.Path).Files
If f.DateLastModified > Now() - NumberOfDays And f.Type = "Microsoft Excel Worksheet" Then
ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) = "=hyperlink(""" & f.Path & """,""" & f.ShortName & """)"
End If
Next
Next
For Each f In fso.GetFolder(folder).Files
If f.DateLastModified > Now() - NumberOfDays And f.Type = "Microsoft Excel Worksheet" Then
ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) = "=hyperlink(""" & f.Path & """,""" & f.ShortName & """)"
End If
Next

End Sub
[/VBA]

HTH
Cal

[Wolfgang]

Cal,
Excel barks at the line below:

Set wb = ActiveWorkbook Set ws = ActiveSheet

Best,
Wolfgang

[CBrine]

Wolfgang,
I deleted a return somehow. Those should be on seperate lines.

[VBA]
Sub GetModifiedFiles()
Dim f As Object, fso As Object, flder As Object
Dim folder As String, NumberOfDays As Integer
Dim wb As Workbook, ws As Worksheet
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
NumberOfDays=InputBox("Enter NumberOfDays")

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
End
End If
folder = .SelectedItems(1)
End With
For Each flder In fso.GetFolder(folder).SubFolders
For Each f In fso.GetFolder(flder.Path).Files
If f.DateLastModified > Now() - NumberOfDays And f.Type = "Microsoft Excel Worksheet" Then
ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) = "=hyperlink(""" & f.Path & """,""" & f.ShortName & """)"
End If
Next
Next
For Each f In fso.GetFolder(folder).Files
If f.DateLastModified > Now() - NumberOfDays And f.Type = "Microsoft Excel Worksheet" Then
ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) = "=hyperlink(""" & f.Path & """,""" & f.ShortName & """)"
End If
Next

End Sub
[/VBA]

[Wolfgang]

Cal,

now it does not find a single file anymore...

The code runs, I can see that but it no returns...

Best,
Wolfgang

[Wolfgang]

Now Here This...

Cal, it works on my US-machine with Office 2003 Pro...

It does not work on my machine with German Windows XP and Office XP...

Since I do most of my work using the US-setup I am more than happy with what you gave me...

Thank you very very much for all of your time and work that you have spent on this...

...I guess I owe you lots of beers...

Best,
Wolfgang

[CBrine]

Wolfgang,
Sorry, no guarantees on non English machines(Of course there are no guarantees on English machines either;-) ). Glad it's working on the English machine. I'm wondering if the hyperlink formula might be different on the German one. If you want to get it to work on that one, try typing in a =hyperlink() formula on it's excel version and see what happens. It may not be available.

I will be having the "Lots of beers" tonight.
:-)