Return Hyperlink for Corresponding File from a List on Worksheet.

[jcoleman25]

Forgive me if this is covered somewhere else, I've looked around but it seems to be fairly specific.

I have a list of customer part numbers that I would like to search for the corresponding file in a folder and subfolders. (the pdf print of a sheetmetal part for example).

The files will often have a revision on them. So the first part number might have a file name 172292_A or 172292_AB.

This is what the end result might look like:

PART#	Link
172292	(hyperlink)
135325	(hyperlink)
150413	Not Found
2104-149	(hyperlink)

<tbody>
</tbody>

I have very limited experience with VBA so this problem is over my head (for now). I usually just move information around within a workbook. This will eventually be used on Windows 7 machines with Excel 2010. Backwards compatibility is not necessary.

Any help is appreciated. Thanks

John

 

[Al Chara]

Does the main folder only have one level of subfolders, or could there be subfolders of the subfolders?

 

[jcoleman25]

There are subs within subs and some of the subs are compressed. Not sure if that makes a difference.

 

[Al Chara]

Compressed, do you mean, like a ZIP file, or similar?

 

[jcoleman25]

Some of the sub folders are zipped, yes.

 

[Al Chara]

This should get you started with the folders and subfolders search. I'm not too sure about the zip files, but you can take a look here for some ideas.

Const FolderPath As String = "C:\Temp"
Const CellRange As String = "A2:A4"
Dim strFilePath As String


Sub AddLinks()


    Dim rngPartList As Range, rngPartNo As Range
    
    Set rngPartList = ActiveSheet.Range(CellRange)
    For Each rngPartNo In rngPartList
        FolderSearch FolderPath, rngPartNo
        ActiveSheet.Hyperlinks.Add Anchor:=rngPartNo.Offset(0, 1), Address:=strFilePath
    Next rngPartNo


End Sub


Sub FolderSearch(MyPath, strMatch)
    
    Dim fso, folder, SubFolders, subfolder, file
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.Getfolder(MyPath)
    Set SubFolders = folder.SubFolders
    For Each subfolder In SubFolders
        For Each file In subfolder.Files
            If InStr(file, strMatch) > 0 Then
                strFilePath = file
                Exit Sub
            End If
        Next file
        FolderSearch subfolder, strMatch
    Next
    
End Sub

 

[Al Chara]

If you will have files in the root directory, then use the code below.

Const FolderPath As String = "C:\Temp\"
Const CellRange As String = "A2:A4"
Dim strFilePath As String


Sub AddLinks()


    Dim rngPartList As Range, rngPartNo As Range
    
    Set rngPartList = ActiveSheet.Range(CellRange)
    For Each rngPartNo In rngPartList
        FolderSearch FolderPath, rngPartNo, 0
        ActiveSheet.Hyperlinks.Add Anchor:=rngPartNo.Offset(0, 1), Address:=strFilePath
    Next rngPartNo


End Sub


Sub FolderSearch(MyPath, strMatch, counter As Boolean)
    
    Dim fso, folder, SubFolders, subfolder, file
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.Getfolder(MyPath)
    If counter = 0 Then
        For Each file In folder.Files
            If InStr(file, strMatch) > 0 Then
                strFilePath = file
                Exit Sub
            End If
        Next file
    End If
    Set SubFolders = folder.SubFolders
    For Each subfolder In SubFolders
        For Each file In subfolder.Files
            If InStr(file, strMatch) > 0 Then
                strFilePath = file
                Exit Sub
            End If
        Next file
        FolderSearch subfolder, strMatch, 1
    Next
End Sub

 

[jcoleman25]

Thanks Allan! I'll start playing with them and see what they can do and hopefully learn how they do it.
I'll let you know what I find. Thanks again.

 

[jcoleman25]

OK, doesn't seem to do anything. I'm trying to follow the logic of it but it's all still very new to me.
Code below with a few edits for my specific testing and some questions.

'from Allan on Mr. Excel
Const FolderPath As String = "C:\Users\jcoleman\Desktop\temp test" 
[B] 'edited^[/B]
Const CellRange As String = "A1:A15"  [B] 'edited[/B]
Dim strFilePath As String

Sub AddLinks()

    Dim rngPartList As Range, rngPartNo As Range
    
    Set rngPartList = ActiveSheet.Range(CellRange)
    For Each rngPartNo In rngPartList
        FolderSearch FolderPath, rngPartNo[B] 'same as Call FolderSearch?[/B]
        ActiveSheet.Hyperlinks.Add Anchor:=rngPartNo.Offset(0, 1), Address:=strFilePath
    Next rngPartNo

End Sub

Sub FolderSearch(MyPath, strMatch)
    
    Dim fso, folder, SubFolders, subfolder, file
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.Getfolder(MyPath) [B]'Where does it get MyPath from?[/B]
    Set SubFolders = folder.SubFolders
    For Each subfolder In SubFolders[B] 'Where does it get subfolder from?[/B]
        For Each file In subfolder.files
            If InStr(file, strMatch) > 0 Then
                strFilePath = file
                Exit Sub
            End If
        Next file
        FolderSearch subfolder, strMatch
    Next
    
End Sub

And may I just say that I'm awfully impressed with myself for figuring out how to post the code

 

[Al Chara]

I made updates to the code, which fixes some bugs I found. I'm not sure if this will fix the issues that you were having with the code, but give it a go and let me know if it works for you. Make sure when you run the code, the active sheet is the one with the part no list.

To answer your questions:

1. same as Call FolderSearch? - You are not required to use the Call keyword when calling a procedure. However, if you use the Call keyword to call a procedure that requires arguments, argumentlist must be enclosed in parentheses. If you omit the Call keyword, you also must omit the parentheses around argumentlist.
2. Where does it get MyPath from? - The value of MyPath is assigned when calling the FolderSearch procedure. In this example, FolderSearch FolderPath, rngPartNo, 0, the value of FolderPath is assigned to MyPath.
3. Where does it get subfolder from? - Subfolder is defined as an element of the SubFolders collection in the For Each...Next Statement.

Const FolderPath As String = "C:\Users\jcoleman\Desktop\temp test"
Const CellRange As String = "A2:A5"
Dim strFilePath As String


Sub AddLinks()


    Dim rngPartList As Range, rngPartNo As Range
    
    Set rngPartList = ActiveSheet.Range(CellRange)
    For Each rngPartNo In rngPartList
        FolderSearch FolderPath, rngPartNo, 0
        ActiveSheet.Hyperlinks.Add Anchor:=rngPartNo.Offset(0, 1), Address:=strFilePath
        strFilePath = vbNullString
    Next rngPartNo


End Sub


Sub FolderSearch(MyPath, strMatch, counter As Boolean)
    
    Dim fso, folder, SubFolders, subfolder, file
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.Getfolder(MyPath)
    If counter = 0 Then
        For Each file In folder.files
            If InStr(1, file.Name, strMatch, vbTextCompare) > 0 Then
                strFilePath = file
                Exit Sub
            End If
        Next file
    End If
    Set SubFolders = folder.SubFolders
    For Each subfolder In SubFolders
        For Each file In subfolder.files
            If InStr(1, file.Name, strMatch, vbTextCompare) > 0 Then
                strFilePath = file
                Exit Sub
            End If
        Next file
        FolderSearch subfolder, strMatch, 1
    Next subfolder
    
End Sub