Oren's Folder: July 2009

Wednesday, July 22, 2009

Search and Log using SQL

Good evening. The following is an SQL-based version of the Search and Log script.

Here the search is done with the '.Global' parameter turned to false, and so the SQL also takes care of finding the number of instances per file. The logging starts after the search is done, and non-matching folders aren't listed.

SQL usage details: The script creates a temporary table called 'search_log'. My default database is the Northwind sample database, and the connection string is suited to windows authentication mode.

' Search and Log using SQL
' (c) Oren Hadar, 2009

Option Explicit

Dim fso, wshell, f, mainFolder, mySearch, sfInclude, logFileName, logFile, _
cnn, rs, fc, f1, fileSearched, fileMatch, sfc, sf1, _
i, rs2, i2, most

Sub Define

Set fso = CreateObject("Scripting.FileSystemObject")
Set wshell = createobject("wscript.shell")

On Error Resume Next
Set f = fso.GetFolder(InputBox("Enter subfolder or full path:", , wshell.currentdirectory))
If f = False Then 
MsgBox "The entered path does not exist, " _
& "or Cancel was pressed.", vbExclamation
WScript.Quit
End If

mainFolder = f

Set mySearch = New RegExp
With mySearch
  .Pattern = InputBox("Enter search string:")
  .Global = False
  .IgnoreCase = True
End With

If f.subfolders.Count > 0 Then
sfInclude = MsgBox("Include SubFolders?", vbYesNo)
End If

logFileName = "~" & f.name & " - find '" & mySearch.Pattern & "'.tmp"
Set logFile = fso.CreateTextFile(logFileName , True)

logFile.Write("Searching for '" & mySearch.Pattern & "' in " & Chr(34) & mainFolder & Chr(34))
If sfInclude = vbYes Then logFile.Write(" and its' subfolders")
logFile.Write(":" & vbCrLf & vbCrLf)

Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cnn.ConnectionString = "driver={SQL Server};" & _
"server=USER-PC\SQLEXPRESS;database=Northwind;Trusted_Connection=Yes"
cnn.Open

cnn.Execute("Create Table search_log (Path varchar(255), " _
& "FileName varchar(255), Instances Int, FileType varchar(255))")

End Sub

Sub Search

Set fc = f.Files
For Each f1 in fc
If mySearch.Execute(f1.name).Count => 1 Then
cnn.Execute("Insert Into search_log (Path, FileName, FileType) " _
& "Values ('" & Replace(Replace(f1.ParentFolder, mainFolder, ".."), "'", "_") _
& "\', '" & Replace(f1.name, "'", "_") & "', '" & Replace(f1.type, "'", "_") & "')") 
End If
Next

If sfInclude = vbYes Then
Set sfc = f.Subfolders
For Each sf1 In sfc
 Set f = fso.GetFolder(sf1)
 Call Search
Next
End If

End Sub

Sub Log

If cnn.Execute("Select Count(*) From search_log")(0) = 0 Then
logFile.Write(vbCrLf & "No matches were found.")
Exit Sub
End If

cnn.Execute("Update search_log Set Instances = " _
& "(LEN(FileName) - LEN(REPLACE(FileName, '" & mySearch.Pattern & "', ''))) " _
& " / LEN('" & mySearch.Pattern & "')")

Set rs = cnn.Execute("Select Path, Count(FileName), Sum(Instances) From search_log Group By Path")
rs.MoveFirst

For i = 1 To cnn.Execute("Select Count(Distinct Path) From search_log")(0)
logFile.Write(vbCrLf & vbCrLf & rs(0) & "  [" & rs(2) & " instance")
If rs(2) > 1 Then logFile.Write("s")
logFile.Write(" in " & rs(1) & " file")
If rs(1) > 1 Then logFile.Write("s")
logFile.Write("]" & vbCrLf)

Set rs2 = cnn.Execute("Select FileName, Instances From search_log Where Path = '" _
& rs(0) & "'")
rs2.MoveFirst

For i2 = 1 To cnn.Execute("Select Count(*) From search_log Where Path = '" _
& rs(0) & "'")(0)
logFile.Write(rs2(0) & "  [" & rs2(1) & " instance")
If rs2(1) > 1 Then logFile.Write("s")
logFile.Write("]" & vbCrLF)
rs2.MoveNext
Next

rs.MoveNext
Next

rs.Close
rs2.Close

End Sub

Sub Summary

logFile.Write(vbCrLf & vbCrLf & vbCrLf & "* * * * * * * *" _
& vbCrLf & "Search Summary" & vbCrLf _
& "* * * * * * * *" & vbCrLf & vbCrLf & vbCrLf)

logFile.Write(cnn.Execute("Select SUM(Instances) From search_log")(0) _
& " instances of '" & mySearch.Pattern & "' were found in " _
& cnn.Execute("Select Count(FileName) From search_log")(0) & " files, inside " _
& cnn.Execute("Select Count(Distinct Path) From search_log")(0) & " folders." _
& vbCrLf & vbCrLf & vbCrLf & vbCrLf)

Set rs = cnn.Execute("Select Path, Count(FileName), SUM(Instances) From search_log " _
& "Group by Path Order by Count(FileName) DESC")
rs.MoveFirst
most = rs(1)

logFile.Write("Folder(s) with most matching files  [" & most & " files]" & vbCrLf)

Do
logFile.Write(rs(0) & "  [" & rs(2) & " instances]" & vbCrLf)
On Error Resume Next
rs.MoveNext
Loop While rs(1) = most

rs.Close

logFile.Write(vbCrLf & vbCrLf & vbCrLF)

Set rs = cnn.Execute("Select Path, SUM(Instances), Count(FileName) From search_log " _
& "Group by Path Order by SUM(Instances) DESC")
rs.MoveFirst
most = rs(1)

logFile.Write("Folder(s) with most instances  [" & most & " instances]" & vbCrLf)

Do
logFile.Write(rs(0) & "  [" & rs(2) & " files]" & vbCrLf)
On Error Resume Next
rs.MoveNext
Loop While rs(1) = most

rs.Close

logFile.Write(vbCrLf & vbCrLf & vbCrLF)

Set rs = cnn.Execute("Select FileType, Count(FileName) From search_log " _
& "Group by FileType Order by Count(FileName) DESC")
rs.MoveFirst

logFile.Write("The matching files are of the following " _
& cnn.Execute("Select Count(Distinct FileType) From search_log")(0) _
& " file types, in descending order:" & vbCrLf)

Do
logFile.Write(rs(0) & "  [" & rs(1) & " files]" & vbCrLf)
On Error Resume Next
rs.MoveNext
Loop While rs(1) > 0

End Sub

Call Define
Call Search
Call Log
If sfInclude = vbYes And _
cnn.Execute("Select Count(*) From search_log")(0) > 0 Then Call Summary

cnn.Execute("Drop Table search_log")
cnn.Close
logFile.Close
fso.MoveFile logFileName, Mid(Replace(logFileName,".tmp" , ".log"), 2)

Saturday, July 18, 2009

Search and Log [VBScript]

Greetings. I wrote a script that Searches for a string in file names and Logs the results in a text file. It has the following neat features:

* Search results refer also to the number of instances the searched string appears in the file name.

* While the process is running, search data is written to a ~.tmp file, and on successful completion the file is renamed to .log.
File names summarize the target of the search, and cannot be overridden.

* If the selected folder for search contains subfolders, the user is prompted to include them in the search. By calling the search sub procedure from itself, the search drills down into deepest subfolders.

* For searches that include subfolders, a short summary of the search results is featured in the end of the log file, including a list of the file types for the matching files, in descending order.

' Search and Log
' (c) Oren Hadar, 2009

Option Explicit

Dim fso, f, wshell, mainFolder, mySearch, logFile, sfInclude, logFileName, _ 
f1, fc, fileSearched, fileMatch, filesInstances, totalInstances, filesMatching, _
filesTable(), fileId, foldersTable(), folderId, sf1, sfc, _
genI, topX, TopXId, genNestedI, groupTable, groupId, groupExists, _
groupOrderedTable, groupOrderedTableId, tempTopGroup

Sub Define

Set fso = CreateObject("Scripting.FileSystemObject")
Set wshell = createobject("wscript.shell")

mainFolder = f

Set mySearch = New RegExp
With mySearch
  .Pattern = InputBox("Enter search string:")
  .Global = True
  .IgnoreCase = True
End With

If f.subfolders.Count > 0 Then
sfInclude = MsgBox("Include SubFolders?", vbYesNo)
End If

logFileName = "~" & f.name & " - find '" & mySearch.Pattern & "'.tmp"
Set logFile = fso.CreateTextFile(logFileName , True)

logFile.Write("Searching for '" & mySearch.Pattern & "' in " & Chr(34) & mainFolder & Chr(34))
If sfInclude = vbYes Then logFile.Write(" and its' subfolders")
logFile.Write(":" & vbCrLf & vbCrLf)

End Sub

Sub Search

filesInstances = Empty
filesMatching = Empty

If f <> mainFolder Then logFile.Write(".." _
& Replace(f, mainFolder, "") & "\" & vbCrLf)

Set fc = f.Files
For Each f1 in fc
 Set fileSearched = mySearch.Execute(f1.name)
 For Each fileMatch in fileSearched  
  filesInstances = filesInstances + 1
  totalInstances = totalInstances + 1
 Next
If fileSearched.Count > 0 Then
logFile.Write(f1.name & "  [" & fileSearched.Count & " instances]" & vbCrLf)
ReDim Preserve filesTable(2, fileId)
filesTable(0, fileId) = f1
filesTable(1, fileId) = fileSearched.Count
filesTable(2, fileId) = f1.type
filesMatching = filesMatching + 1
fileId = fileId + 1
End If
Next

If filesInstances > 0 Then
ReDim Preserve foldersTable(2, folderId)
foldersTable(0, folderId) = f
foldersTable(1, folderId) = filesMatching
foldersTable(2, folderId) = filesInstances
folderId = folderId + 1
End If

Select Case filesInstances
Case 0
logFile.Write("No matches were found")
If f = mainFolder And sfInclude = vbYes Then logFile.Write(" in the main folder")
logFile.Write("." & vbCrLf & vbCrLf & vbCrLf)
Case 1
logFile.Write("[1 instance in 1 file]" & vbCrLf & vbCrLf & vbCrLf)
Case Else
logFile.Write("[" & filesInstances & " instances in " & filesMatching _
& " files]" & vbCrLf & vbCrLf & vbCrLf)
End Select

If sfInclude = vbYes Then
Set sfc = f.Subfolders
For Each sf1 In sfc
 Set f = fso.GetFolder(sf1)
 Call Search
Next
End If

End Sub

Sub Summary

logFile.Write("* * * * * * * *" & vbCrLf _
& "Search Summary" & vbCrLf _
& "* * * * * * * *" & vbCrLf & vbCrLf & vbCrLf)

If totalInstances = 0 Then 
logFile.Write("No instances of '" & mySearch.Pattern & "' were found.")
Exit Sub
End If

logFile.Write(totalInstances & " instances of '" & mySearch.Pattern _
& "' were found in " & fileId & " files, inside " & folderId & " folders." _
& vbCrLf & vbCrLf & vbCrLf & vbCrLf)

Call ResVar

For genI = 0 To folderId - 1
If foldersTable(1, genI) > foldersTable(1, topX(0)) Then
 ReDim topX(0)
 topX(0) = genI
ElseIf foldersTable(1, genI) = foldersTable(1, topX(0)) And _
foldersTable(0, genI) <> foldersTable(0, topX(0)) Then
 topXId = topXId + 1
 ReDim Preserve topX(topXId)
 topX(topXId)=genI
End If
Next

If topXId = 1 Then topXId = 0

LogFile.Write("Folder(s) with most matching files [" _
& foldersTable(1, topX(0)) & " files]:" & vbCrLf)

For genI=0 To topXId
logFile.Write(foldersTable(0, topX(genI)) & "  [" & foldersTable(2, topX(genI)) _
& " instances]" & vbCrLf)
Next

logFile.Write(vbCrLf & vbCrLf & vbCrLf)

Call ResVar

For genI = 0 To folderId - 1
If foldersTable(2, genI) > foldersTable(2, topX(0)) Then
 ReDim topX(0)
 topX(0) = genI
ElseIf foldersTable(2, genI) = foldersTable(2, topX(0)) And _
foldersTable(0, genI) <> foldersTable(0, topX(0)) Then
 topXId = topXId + 1
 ReDim Preserve topX(topXId)
 topX(topXId)=genI
End If
Next

LogFile.Write("Folder(s) with most instances [" _
& foldersTable(2, topX(0)) & " instances]:" & vbCrLf)

If topXId = 1 Then topXId = 0

For genI=0 To topXId
logFile.Write(foldersTable(0, topX(genI)) & "  [" & foldersTable(1, topX(genI)) _
& " files]" & vbCrLf)
Next

logFile.Write(vbCrLf & vbCrLf & vbCrLf)

Call ResVar

For genI = 0 To fileId - 1
 groupExists = False
 For genNestedI = 0 To groupId
  If filesTable(2, genI) = groupTable(0, genNestedI) Then
  groupExists = True
  groupTable(1, genNestedI) = groupTable(1, genNestedI) + 1
  End If
 Next
 If groupExists = False Then
 groupId = groupId + 1
 ReDim Preserve groupTable(1, groupId)
 groupTable(0, groupId) = filesTable(2, genI)
 groupTable(1, groupId) = 1
 End If
Next

ReDim groupOrderedTable(1, groupId)

For genI = 0 To groupId
 For genNestedI = 0 To groupId
 If groupTable(1, genNestedI) > groupOrderedTable(1, genI) Then
 groupOrderedTable(0, genI) =  groupTable(0, genNestedI)
 groupOrderedTable(1, genI) =  groupTable(1, genNestedI)
 tempTopGroup = genNestedI
 End If
 Next
groupTable(1, tempTopGroup) = 0
Next

logFile.Write("The matching files are of the following " _
& groupId & " file types, in descending order:" & vbCrLf)

For genI = 0 To groupId - 1
logFile.Write(groupOrderedTable(0, genI) & "  [" & groupOrderedTable(1, genI) & " files]" & vbCrLf)
Next

End Sub

Sub ResVar

ReDim topX(0)
topX(0) = 0
topXId = 0

ReDim groupTable(1, 0)
groupTable(0, 0) = "No File Type"
groupTable(1, 0) = 0
groupId = Empty

End Sub

Call Define
Call Search
If sfInclude = vbYes Then Call Summary

logFile.Close
fso.MoveFile logFileName, Mid(Replace(logFileName,".tmp" , ".log"), 2)

Saturday, July 4, 2009

Convert Footnotes to Regular Text [Word VBScript]

The next script for Word converts all footnotes and their references to regular text. The footnotes are inserted at the end of the document.

Find, Replace and Comment [Word VBScript]

Hi there. I wrote a Find and Replace script for Word, which also adds a Comment for each replacement. Note: It works only on the 'body' of the text, since comments are not available on footnotes / endnotes.

Sub find_comment()

' Find, Replace and Comment
' (c) Oren Hadar, 2009

Dim myFind
Dim myReplace
Dim okInput
Dim myCount
Dim myContinue
Dim myRetry

myCount = 0
okInput = False

Do
myFind = InputBox("Find what:", "Find and Comment")
If StrPtr(myFind) = False Then
Exit Sub
ElseIf myFind = "" Then
myRetry = MsgBox("No find string was entered.", _
vbRetryCancel + vbExclamation, "Find and Comment")
Else
okInput = True
End If
If myRetry = vbCancel Then
Exit Sub
End If
Loop While okInput = False

okInput = False

Do
myReplace = InputBox("Replace with:", "Find and Comment")
If StrPtr(myReplace) = False Then
Exit Sub
ElseIf myReplace = "" Then
myRetry = MsgBox("No replacement string was entered." _
& vbCrLf & "The searched string will be deleted!" & vbCrLf _
& "Are you sure?", vbYesNoCancel + vbDefaultButton2 + _
vbExclamation, "Find and Comment")
ElseIf myReplace = myFind Then
myRetry = MsgBox("The replacement string must be different " & vbCrLf _
& "from the searched string.", vbRetryCancel + vbCritical, "Find and Comment")
Else
okInput = True
End If
If myRetry = vbYes Then
okInput = True
ElseIf myRetry = vbCancel Then
Exit Sub
End If
Loop While okInput = False

Do
With Selection.find
    .Forward = True
    .ClearFormatting
    .MatchWholeWord = False
    .MatchCase = False
    .Wrap = wdFindContinue
    .Execute FindText:=myFind
End With
If Selection.Text = myFind Then
Selection.Text = myReplace
myContinue = True
myCount = myCount + 1
ActiveDocument.Comments.Add Range:=Selection.Range, Text:="Replaces " & myFind
Else
myContinue = False
End If
Loop Until myContinue = False
    
MsgBox myCount & " instances of '" & myFind _
& "' were found, replaced with '" & myReplace & _
"' and commented.", , "Find and Comment"

End Sub

Oren's Folder

Wednesday, July 22, 2009

Search and Log using SQL

Saturday, July 18, 2009

Search and Log [VBScript]

Saturday, July 4, 2009

Convert Footnotes to Regular Text [Word VBScript]

Find, Replace and Comment [Word VBScript]

Blog Archive

Labels

Contact Me:

Disclaimer