PDA

View Full Version : Adding subfolders into routine



Bullracer2
05-04-2015, 10:03 PM
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/16908344/vba-macro-replace-text-in-word-file-in-all-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
05-05-2015, 04:41 AM
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
05-05-2015, 03:40 PM
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.
13301
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.

13302

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
05-05-2015, 05:05 PM
hi.
google "excel vba recursive sub" or "excel vba recursion."

jonh
05-06-2015, 12:50 AM
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