Dim IE,fso, dirStart, folder, Sh, LogFile, DirHTM, FilesCount
'---------------------------------------------------------------'   

ScanFolder

'---------------------------------------------------------------'
Function ScanFolder()
Dim rez
Set IE  = CreateObject("InternetExplorer.Application")
Set fso = CreateObject ("Scripting.FileSystemObject")
Set Sh  = CreateObject("wscript.shell")

    IE.Visible = false
	IE.MenuBar = false
	IE.Toolbar = false
	
	DirHTM = "D:\Projects\HTM"
	LogFile = DirHTM & "\Innertext.txt"
	FilesCount = 0
	
set folder = fso.GetFolder( DirHTM )

   ProcessDir(folder)
   IE.Quit
   rez = "Сканирование в каталога: " & DirHTM & vbcrlf & "завершено, обработано файлов: " & CStr(FilesCount) & vbcrlf & vbcrlf & "Резульат записан в файл: " & vbcrlf & LogFile
   Wait 600, rez
   
End Function
'---------------------------------------------------------------------------'
'обработка  директории '
Sub ProcessDir( folder )
    dim file, subfolder
    For Each file in folder.Files
    if (InStr(file.Path, ".htm")>0) then
	    FilesCount=FilesCount+1
        log( Date & " " & Time & " " & file.Path ) 
		GetText "file:///" & file.Path
        end if        
    next
	
    For Each subfolder in folder.SubFolders
        ProcessDir( subfolder )
    Next
	
End Sub
'---------------------------------------------------------------'
Function GetText(URLStr)
    dim frames, curr_frame, tmp_frame
	       
        IE.Navigate URLStr
        While IE.readyState < 4
	    Wait 1, "Ждем открытия..." & vbcrlf & URLStr
	    Wend 
 
	    'здесь текст, сохранение в файл'
	    log IE.document.body.innertext
		
		' теперь фреймы'
		frames = IE.document.frames.length
		curr_frame=frames
		while curr_frame>0
			log "Frame: " & CStr(curr_frame)
			set tmp_frame=IE.document.frames(curr_frame-1)
			log tmp_frame.document.body.InnerText
		curr_frame=curr_frame-1
		wend

End Function
'---------------------------------------------------------------'
Sub Wait(Seconds, Message) 
  On Error Resume Next 
  Sh.Popup Message, Seconds, "", 64 
End Sub 
'---------------------------------------------------------------'
Sub log(sData)
    Dim ts, ForAppending
    ForAppending = 8
    Set ts = fso.OpenTextFile( LogFile , ForAppending, True)
    ts.Write sData & chr(13) & chr(10)
    ts.Close
End Sub