VB - recursively searching all directories - HELP 1

[AndyZ]

Anyone who can help,
I'm in the process of developing a VB program (.exe) that I can run on my file servers to detect & print changes in the file system of a particular drive. The code I have so far will only search SOME directories for files but misses other dirs. I can't figure out why. Also, it will only recursively examine under the directory that the .exe was saved in. Can anyone at least tell me if I'm headed in the right direction to reach my goal? Goal: To create a comma-delimitted file that lists every file and its properties (size, attribs., etc.) on a particular drive. Then to compare it a month later with the current file system and print out changes.
Ideas welcome. Thanks.

Here's what I have so far (some of the code is probably not necessary):

Option Explicit
Dim mFileSysObj As New FileSystemObject
Dim fs As New FileSystemObject
Dim fso As New FileSystemObject
Dim File As String
Dim a
Dim fld As Folder
Dim DPath As String
Dim sDir As String
Dim nFiles As Variant

Private Sub Command1_Click()
Dim lSize As Variant
Dim sSrchString As String

sDir = Drive1.Drive
DPath = Left(sDir, 2)
sSrchString = "*.*"
File = (DPath & "\Snapshot.txt&quot
Set fs = CreateObject "Scripting.FileSystemObject&quot
Set a = fs.CreateTextFile(File, True)
lSize = FindFile(DPath, sSrchString, nFiles)
MsgBox "Snapshot of " & sDir & " taken successfully." & vbCrLf & vbCrLf & DPath & "\snapshot.txt created."
a.Close
End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, nFiles As Variant) As Variant
Dim tFld As Folder
Dim tFil As File
Dim FileName As String
Dim theFile As File

Set fso = CreateObject("Scripting.FileSystemObject&quot
Set fld = fso.GetFolder(sFol)

FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)

Set fso = CreateObject("Scripting.FileSystemObject&quot
Set theFile = mFileSysObj.GetFile(fld.Path & "\" & FileName)
While Len(FileName) <> 0
On Error Resume Next
FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
a.WriteLine fso.BuildPath(fld.Path, FileName) & &quot;,&quot; & theFile.DateCreated & &quot;,&quot; & theFile.DateLastAccessed & &quot;,&quot; & theFile.DateLastModified & &quot;,&quot; & theFile.Size & &quot;,&quot; & theFile.Attributes
FileName = Dir()
DoEvents
Wend
Label1.Caption = &quot;Taking Snapshot&quot; & vbCrLf & fld.Path & &quot;...&quot;
If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nFiles)
On Error Resume Next
Next
End If
End Function

Private Sub Command2_Click()
Unload Form1
End Sub

This code is a mess. Any suggestions on cleaning it up?
Sorry for the *HUGE* post.
db

 

[kevinclark]

Hope this may help. Got to love recursive algorithms

Dim FSO As New FileSystemObject

Sub InitiateSearch()
Set FSO = CreateObject(&quot;Scripting.FileSystemObject&quot
RecursiveSearch &quot;C:\&quot;
End Sub

Function RecursiveSearch(fldr)
Dim fo 'Folder Object
Dim fc 'Folder Collection
Dim F_item 'Dual Purpose - File and then SubFolder
Dim fls 'File Collection

Set fo = FSO.GetFolder(fldr)
Set fc = fo.SubFolders
Set fls = fo.Files

'Get each file
For Each F_item In fls
MsgBox F_item
MsgBox F_item.Name
'REPLACE THE MSGBOX's TO WRITE TO
'TXT FILE OR DATABASE etc.....
Next F_item

'Handle any Sub Folders
For Each F_item In fc
RecursiveSearch (fldr + &quot;\&quot; + F_item.Name)
Next F_item

Set fo = Nothing
Set fc = Nothing
End Function

 

[kevinclark]

If you have Microsoft Word available then this is one method you can use. Pretty simple.

'Insert this code where indicted in my last posting.
'Note: I have hard coded the file name Test1.txt but
'you will need to make this dynamic so that you can
'create different files to compare.

Open &quot;C:\Some Path\Test1.txt&quot; For Append As #1
Print #1, F_item
Close #1

'Anyway after inserting this code where indicated
'run the recursive app. Use Ctrl-Break to interupt
'the code after a couple seconds. Then go in to the
'code and change the name of Test1.txt to Test2.txt
'run the code again but for a little longer so you
'are sure to have differences between the two files


'Now here is where you can use word to compare the
'two files. Simply cut and paste this code in and
'modify the paths to the two Test files. Once you
'run this code you should see Microsoft open both
'files into one document and highlight the differences
'between the two.

Sub CompareFiles()
Dim MSDoc
Dim FSO
Dim txt_1
Dim txt_2
'change the paths accordingly
txt_1 = &quot;C:\Development\Excel\Test.txt&quot;
txt_2 = &quot;C:\Development\Excel\Test2.txt&quot;
Set FSO = CreateObject(&quot;Scripting.FileSystemObject&quot
Set MSDoc = CreateObject(&quot;Word.Application&quot
MSDoc.Documents.Open txt_1
MSDoc.ActiveDocument.Compare txt_2
MSDoc.Visible = True
End Sub

 

[AndyZ]

Thanks kevinclark!
This all looks very helpful. That is definately a better way to search directories that the way I was using, & more efficient. My only concern is having to use Word to compare the 2 files. Very cool idea that I can't wait to try from my pc, but most (if not all) of the W2K servers that I'll be running this on don't have Word (or any MS Office products) installed on them. A friend of mine recommended reading the files into a variable array and comparing them that way - line for line. I wouldn't even know where to start coding for that.

I REALLY appreciate you help so far. Do you have any other ideas on how to display the differences between the two text files? That seems to be the greatest challenge.

 

[kevinclark]

See if this would help point you in that direction then.


Private Sub CompareFiles()
Dim tmp As Integer
Dim File_1 As String
Dim File_2 As String
Dim File_3 As String

File_1 = &quot;C:\Dev_Fldr\QuickTest\Test1.txt&quot;
File_2 = &quot;C:\Dev_Fldr\QuickTest\Test2.txt&quot;
File_3 = &quot;C:\Dev_Fldr\QuickTest\Test3.txt&quot;

'Open File1 and store in Memory
Open File_1 For Input As #1
tmpFile1 = Input(LOF(1), #1)
Close #1

'Open File2 and 3
Open File_2 For Input As #2
Open File_3 For Output As #3

'Loop thru #2 and compare each line between file1 in
'memory and file 2. If different then write diff to
'file 3
Do While Not EOF(2)
Line Input #2, TextLine
tmp = InStr(1, UCase(tmpFile1), UCase(TextLine))
If tmp = 0 Then Print #3, TextLine
Loop

Close #2
Close #3
End Sub

 

[AndyZ]

Thanks for the additional advice kevinclark! I'm amazed by your ability to whip up this code.
I will give this a try. I would ultimately like to sort the results of the comparison by changes in date modified, last accessed, file size, attribute changes, new files, deleted files, etc. to aid in making sense of the report (File_3).
I know that this will involve much more code but I feel much more comfortable approaching this now with the help you've provided thus far.
Thanks again for your asistance!!

 

[kevinclark]

No problem Andy

While I spend the majority of my time these days involved in project management I still enjoy writing code when the opportunity arises. Glad I could help.

 

[kevinclark]

I should have mentioned this earlier as well. Something to think about. If you are able to fool around with the files Archive property (make sure some back up system is not using it) you could run the recursive program to set them all to unchecked / false.
When a user opens and modify's a file this attribute will be reset to true (ready for archiving). Run the recursive program searching only for files that requrie archiving, write the changes to file and reset the attribute again for next time.

 

[Guest_imported]

Anyone who can help,

I'm writing a macro that does a copy and paste into a textfile but the values at the last 10 columns of my record are wrapping underneath all of my other records in one big chunk. How can I prevent this from happening?
Thanks for any help that you can give.

Dim var1 As String
Dim var2 As String

fname = ActiveWorkbook.Name
distnum = Worksheets(&quot;cover page&quot.Range(&quot;coverpage&quot.Value

'Copy Layout sheet
Sheets(&quot;Layout&quot.Visible = True
Sheets(&quot;Layout&quot.Select
Sheets(&quot;Layout&quot.Copy Before:=Sheets(&quot;Layout&quot

'Copy and &quot;Paste special&quot; records
Worksheets(&quot;SDI&quot.Range(&quot;recordtable&quot.Copy
Worksheets(&quot;Layout (2)&quot.Range(&quot;a1&quot.PasteSpecial Paste:=xlValues

'Rows(&quot;1:1&quot.Delete
'Rows(&quot;2:2&quot.Delete
Range(&quot;d1&quot.Select

Range(&quot;F1:CR200&quot.Select
Selection.Copy
Range(&quot;F1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



'Sort and delete blank records
Worksheets(&quot;Layout (2)&quot.Range(&quot;A1:CR200&quot.Select
Selection.Sort Key1:=Range(&quot;d1&quot, Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns(&quot;d:d&quot.Select
Selection.Find(What:=&quot;&quot;, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Offset(0, 0).Range(&quot;A1&quot.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete




'Format column widths

Range(&quot;A:CR&quot.ColumnWidth = 4

'Delete columns
'Range(&quot;CS:GE&quot.Delete
Range(&quot;C:C&quot.Delete
Range(&quot;A:A&quot.Delete

Range(&quot;A1&quot.Select


'Save Layout sheet with data as text file
Sheets(&quot;Layout (2)&quot.Copy
ver = InputBox(&quot;Enter 2 digit version number&quot
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & &quot;\SDI&quot; & distnum & &quot;.&quot; & ver & &quot;a&quot;, FileFormat:= _
xlTextPrinter, CreateBackup:=False
Sheets(&quot;SDI&quot; & distnum).Select

var1 = &quot;SDI&quot; & distnum & &quot;.&quot; & ver & &quot;a&quot;
var2 = ThisWorkbook.Path & &quot;\&quot; & var1

Application.DisplayAlerts = False
Workbooks(var1).Close
Application.DisplayAlerts = True
Windows(fname).Activate
Application.DisplayAlerts = False
Sheets(&quot;Layout (2)&quot.Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Sheets(&quot;Layout&quot.Select
Sheets(&quot;Layout&quot.Visible = False

Sheets(&quot;cover page&quot.Select

MsgBox (&quot;The text file was saved here: &quot; & var2)
End Sub