Link to file in subdirectory
It took me a couple of minutes to modify another macro I had. the code
recursively goes through all subdirectories and then make the link.
Sub GetLinks()
'
' Macro1 Macro
' Macro recorded 3/2/2008 by Joel
'
'
strFolder = '"\myDir\" 'make sure you leave last backslash
Extension = "apj"
RowCount = 1
Do While Range("A" & RowCount) < ""
location = ""
MyFile = Range("A" & RowCount) & "." & Extension
Call GetSubFolderSize(strFolder, MyFile, location)
if location < "" then
MyFile = location & Range("A" & RowCount) & _
"." & Extension
Range("B" & RowCount).Hyperlinks.Add _
Anchor:=Range("B" & RowCount), _
Address:=MyFile, _
TextToDisplay:=MyFile
end if
RowCount = RowCount + 1
Loop
End Sub
Sub GetSubFolderSize(strFolder, MyFile, ByRef location)
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)
If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetSubFolderSize(strFolder + sf.Name + "\", _
MyFile, location)
If location < "" Then Exit For
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If location = "" Then
If Not folder.isrootfolder Then
FName = Dir(strFolder & MyFile)
If FName < "" Then
location = strFolder
End If
End If
End If
200 On Error GoTo 0
End Sub
"Matthieu B." wrote:
Hi Joel, and thank you for your awnser !
Its a good begining, but what I have to do is a bit more difficult.
Excuse me for my misexplanation.
My files are not all in the directory 'MyDir'.
There are a lot of subdirectories, with various names convention.
I need a function that recursively find the file location with a filter
function.
Exemple : cell A1 contains "A-ZER-TY"
the file to link to is in
\MyDir\projetct\projectblablabla\AZERTY.APJ
I need to put a link in B1 to this file
And so from A1 to Ax.
But I like to thank you a lot for your awnser.
It's a nice begining for me and I will try to work on it to improve your
function.
If anyone have others suggestions, you are welcome !
Best regards,
Matthieu
|