Adding subfolders into routine

[Bullracer2]

Hi, I have a vba code which grabs a bit of info from a heap of .htm documents and puts it into a spreadsheet. The code works well however I want to extend it to also include sub directories. I've had a play with incorporating a similar solution posted at http://stackoverflow.com/questions/1...ll-sub-folders but end up further away then where i started.

My code is as follows:

Sub GetHyperlinksHTML()    Application.ScreenUpdating = False
    Dim StrFolder As String, StrFile As String
    Dim wdApp As Object, wdDoc As Object
    Dim WkSht As Worksheet, LRow As Long, i As Long
    StrFolder = GetFolder
    If StrFolder = "" Then Exit Sub
    Set WkSht = ActiveWorkbook.ActiveSheet


    LRow = WkSht.Cells.SpecialCells(xlCellTypeLastCell).Row
    Set wdApp = CreateObject("Word.Application")
    If wdApp Is Nothing Then
        MsgBox "Can't start Word.", vbExclamation
        Exit Sub
    End If
    StrFile = Dir(StrFolder & "\*.htm", vbNormal)
While StrFile <> ""
    Set wdDoc = wdApp.Documents.Open(Filename:=StrFolder & "\" & StrFile, _
    AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
    With wdDoc
         'Get the data for each defined Excel column
        For i = 1 To .Hyperlinks.Count
            LRow = LRow + 1
            WkSht.Cells(LRow, 1).Value = .FullName
            WkSht.Cells(LRow, 2).Value = .Hyperlinks(i).TextToDisplay
            WkSht.Cells(LRow, 3).Value = .Hyperlinks(i).Address
        Next
        .Close SaveChanges:=False
    End With
    StrFile = Dir()
Wend
wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
    Application.ScreenUpdating = True
End Sub

Any help / points would be appreciated.

Thanks.

[snb]

Can you post a sample htm-file ?
I have no idea what the file looks like, how many hyperlinks it contains, etc.
Getfolder is empty so strfolder must be empty too.
Also I do not understand what you mean by 'subfolders'. Subfolders of which folder ?

[Bullracer2]

Can you post a sample htm-file ?
I have no idea what the file looks like, how many hyperlinks it contains, etc.
Getfolder is empty so strfolder must be empty too.
Also I do not understand what you mean by 'subfolders'. Subfolders of which folder ?

Thanks for the response.

It is for a .chm (Help) file that gets built. Within the folder there are .htm files and there will also be other folders (what i'm referring to as subfolders) which also contain .htm files and sometimes a few additonal subfolders within subfolders.
ScreenHunter_54 May. 06 08.27.jpg
The routine does work fine for that first level but i want it to dig down into these folders. At present i can just rerun the routine and specify the subfolders i know have content but it is a bit tedious.

I've attached a sample file (i think correctly) - there are hundreds of these files some with only a few lines of text and no hyperlinks. To some with hundreds of lines of text and say 20-30 hyperlinks.

4-000 Glossary.zip

I do have a seperate issue with the .texttodisplay not returning anything if the hyperlink is a table (hyperlink still shows correctly) but thats a separate issue and is something that hasn't bothered me too much.

Thanks,

[mancubus]

hi.
google "excel vba recursive sub" or "excel vba recursion."

[jonh]

Sub Example()
    SubFolders CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\")
End Sub

Sub SubFolders(folder)
On Error Resume Next
    Debug.Print folder.Path
    ProcessFiles folder
    For Each fol In folder.SubFolders
        If Err.Number Then Err.Clear Else SubFolders fol
    Next
End Sub

Function ProcessFiles(folder)
    For Each f In folder.Files
        DoSomethingWith f
    Next
End Function

Sub DoSomethingWith(f)
    Debug.Print f.Path
End Sub