Solved: Browse A Folder And Hyperlink All Modified WBs

[Wolfgang]

Hi All...

May I have a macro which will perform the following tasks, please...

Browse through a folder plus its subs, find all modified .xls files, list them in the active workbook and hyperlink them, so that I am able to open a particular wb from here...

Thank you very much and: Stay On The Scene...

Best,
Wolfgang

[CBrine]

all modified .xls files,
Wolfgang,
Can you expand on what you mean by this? Setting up code that would hyperlink all excel files in a folder wouldn't be that difficult. Doing this based on it being modified? That's another story, and depends on what you mean by modified.

Cal

[lucas]

See Ken's kb entry for a start:
Create Hyperlinked List of Directory (http://vbaexpress.com/kb/getarticle.php?kb_id=232)

[lucas]

Ken's entry includes last modified date.....should be able to apply a filter to that data.

[Wolfgang]

Hi Cal...

Thank you very much for your quick reply...

Of course, I forgot to mention the most important part...

By modified I mean all files that have been modified from TODAY() minus 7 days...

Best,
Wolfgang

[Wolfgang]

Hi Lucas...

I was tooooo quick with the buttons...

Ken's macro gives me by far more than I needed...thank you very much and have a great weekend...

Best,
Wolfgang

[CBrine]

Wolfgang,
I put some code together for you, so I'm going to post it anyway. If you figured it out from the KB, no worries.


sub FileLink()
Dim f As Object, fso 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

End With

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


HTH
Cal

PS-Slight change on the error checking.

[Wolfgang]

Hi Cal...

Thank you too for your answer...

I put your code into a module and ran it...

Looks like it does not accept a folder although the folder menu appears ok...

If I try to select one its name does not appear in the menu bar and the code stops...

Any idea?!

Best,
Wolfgang

[CBrine]

Wolfgang,
I've uploaded the test file I created. Give that a try and see if you encounter the same issue.

Cal

[Wolfgang]

Hi Cal...

Still the same..

I get the following error message:

Run-time error 5
Invalid procedure or call argument

For Each f In fso.GetFolder(folder).Files is highlighted...

Best,
Wolfgang

[Wolfgang]

PS:

I am running US Office 2003 Pro SP2 on US XP-Home Edition...

[lucas]

Hi Wolfgang,
haven't had time to look at why.....doesn't appear to be a reference but I get the same error.

[CBrine]

Wolfgang,
When I fixed the error checking, I broke the folder select. Didn't test after I made the change. here's the fixed code.


Sub FileLink()
Dim f As Object, fso 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 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

[lucas]

Something still awry Cal.....its not listing the files in the browse dialog and now I don't get an error but nothing happens.

[Wolfgang]

That's it Cal...

Thanxs a lot...runs great...

BTW: I love Ontario...I practically grew up in Phoenix?!

...have a beer on me...

Wolfgang

[CBrine]

lucas,
The browse dialog is actually a folder selector, not a file selector, so no files should appear. You use it to select the folder, and the process will cycle through each excel file that's been modified in the last 7 days and then creates a hyperlink on the activesheet.

HTH
Cal

Wolfgang,
Glad it's working for you. I'm not sure I get the reference about Ontario and Phoenix though? Maybe your thinking of some other Ontario. I will have the beer though.:-)

[CBrine]

lucas,

PS-Nothing will happen if you select a folder where nothing has been modified in the last 7 days or has no excel files.

[Wolfgang]

Cal...

I am from Bavaria living near Munich...

Us Bavarians are world-wide known for our weird kind of humor...I sure am no exception to the rule...no offence Cal...

But we do are proud of our beer......yeah...

Take care...
Wolfgang

[lucas]

Gotcha Cal....works great after I modified an old excel file.....:thumb

Would make a nice kb entry......would you submit it?

[CBrine]

Sure, I will have to do some reasearch into how to go about submitting it though.

Cal

[lucas]

Johnske walks you through it here (http://vbaexpress.com/forum/showthread.php?p=27962#post27962)
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.


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


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.

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


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.


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

[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.
:-)