Add Hyperlink Per Row For Each Subfolder

[CruciasNZ]

Public FS As New FileSystemObject
Public FSfolder As Folder
Public subfolder As Folder
Public i As Integer
Public existingRange As Range
'---------------------------------------------------------------------------------------
Sub updateProjects()
    Dim strStartPath As String
    Set existingRange = Range("G1").EntireColumn
    strStartPath = "C:\Test\" 'Set Root Filepath
    i = (Cells(Rows.Count, 7).End(xlUp).Offset(1).Row) - 1 'Start First Blank Row (At End)
    Call ScanFolder(strStartPath, i) 'Call Folder List Macro
End Sub
'---------------------------------------------------------------------------------------
Sub ScanFolder(sFolderPath As String, i As Integer)
    Set FSfolder = FS.GetFolder(sFolderPath)
    For Each subfolder In FSfolder.SubFolders
        DoEvents
        Call ScanFolder(sFolderPath, i) 'Recursion
        i = i + 1
        'If IsInArray = Not IsError(Application.Match(subfolder, existingRange, 0)) Then 'Prevent Doubles
            Worksheets("Library").Hyperlinks.Add Anchor:=Worksheets("Library").Cells(i, 6), _
            Address:=sFolderPath 'Add Hyperlink
            'Address:=subfolder 'Add Hyperlink
            Worksheets("Library").Cells(i, 7) = sFolderPath 'Add Search Key Used To Prevent Doubles
        'End If
    Next subfolder
    Set FSfolder = Nothing
End Sub

[TABLE="width: 500"]
<tbody>[TR]
[TD]Stuff[/TD]
[TD]Stuff[/TD]
[TD]Stuff[/TD]
[TD]Stuff[/TD]
[TD]Stuff[/TD]
[TD]File Location[/TD]
[TD]Do Not Touch This Column[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Hyperlink[/TD]
[TD]String of Hyperlink Filepath[/TD]
[/TR]
</tbody>[/TABLE]



Good day everyone,

This keeps giving me a stack overflow error (out of space) on it's first iteration. Basically what I'm trying to do is give it a root filepath, then add hyperlinks (preventing doubles) for each folder and subfolder within that root folder.

Root>Level 1>Level 2>Level 3

I only need Level 3 folders to be listed, or alternatively if a particular Level 2 has no subfolders, list that instead. However I'll settle for getting the core code working at the moment :D

Any help would be appreciated,

Cru

 

[CruciasNZ]

Never mind, think I have solved the problem

Public FS As New FileSystemObjectPublic FSfolder As Folder
Public subfolder As Folder
Public i As Integer
Public existingRange As Range
Public levelOne(9999) As String
Public levelTwo(9999) As String
Public levelThree(9999) As String
Sub updateProjects()
    Dim strStartPath As String
    Set existingRange = Range("G1").EntireColumn
    strStartPath = "C:\Test\" 'Set Root Filepath
    Call ScanLevelOne(strStartPath) 'Call Folder List Macro
End Sub
Sub ScanLevelOne(sFolderPath As String)
    Dim oneCounter As Integer
    Set FSfolder = FS.GetFolder(sFolderPath)
    oneCounter = 0
    For Each subfolder In FSfolder.SubFolders
        DoEvents
            levelOne(oneCounter) = subfolder 'Add Directory
            oneCounter = oneCounter + 1
    Next subfolder
    Set FSfolder = Nothing
    oneCounter = oneCounter - 1
    Call ScanLevelTwo(oneCounter)
End Sub
Sub ScanLevelTwo(maxLevelOne As Integer)
    Dim twoCounter As Integer
    counter = 0
    twoCounter = 0
    Do While (counter) <= (maxLevelOne)
        Set FSfolder = FS.GetFolder(levelOne(counter))
        For Each subfolder In FSfolder.SubFolders
            DoEvents
                levelTwo(twoCounter) = subfolder 'Add Directory
                twoCounter = twoCounter + 1
        Next subfolder
        Set FSfolder = Nothing
        twoCounter = twoCounter - 1
        Call ScanLevelThree(twoCounter)
        counter = counter + 1
        twoCounter = 0
    Loop
End Sub
Sub ScanLevelThree(maxLevelTwo As Integer)
    Dim threeCounter As Integer
    counter = 0
    threeCounter = 0
    Do While (counter) <= (maxLevelTwo)
        Set FSfolder = FS.GetFolder(levelTwo(counter))
        For Each subfolder In FSfolder.SubFolders
            DoEvents
                levelThree(threeCounter) = subfolder 'Add Directory
                threeCounter = threeCounter + 1
        Next subfolder
        Set FSfolder = Nothing
        threeCounter = threeCounter - 1
        Call OutputLevelThree(threeCounter)
        counter = counter + 1
        threeCounter = 0
    Loop
End Sub
Sub OutputLevelThree(maxLevelThree As Integer)
    Dim outputCounter As Integer
    counter = 0
    outputCounter = (Cells(Rows.Count, 7).End(xlUp).Offset(1).Row) - 1 'Start First Blank Row (At End)
    Do While (counter) <= (maxLevelThree)
        Set FSfolder = FS.GetFolder(levelThree(counter))
            outputCounter = outputCounter + 1
            With existingRange
            If IsInArray = Not IsError(Application.Match(CStr(FSfolder), existingRange, 0)) Then 'Prevent Doubles
                Worksheets("Library").Hyperlinks.Add Anchor:=Worksheets("Library").Cells(outputCounter, 6), _
                Address:=FSfolder 'Add Hyperlink
                Worksheets("Library").Cells(outputCounter, 7) = CStr(FSfolder) 'Add Search Key Used To Prevent Doubles
            End If
            End With
        counter = counter + 1
    Loop
End Sub