I’m quite interested in Windows Live lately, but I’m actually a Microsoft Office junkie from way back. Yes, Office is a bloated hog of a software suite for most casual users’ needs (akin to using a sledgehammer to swat a fly). The new ribbon interface makes us all feel like we have to learn how to perform even the most basic tasks all over again. Microsoft seems intent on hiding or disabling all of the rich features that made Office worthwhile for most power users. People are just plain annoyed by the inconsistencies among Office programs for common tasks. Hell, some people are still brooding over the Office Assistant. But if you can get past all of that, Office also has a ton of horsepower and functionality under the hood.
For instance, I was recently asked by my corporate HR department to find a quick way to append a new standard disclaimer to all of their job descriptions, which happen to be maintained as a folder tree of several hundred Word documents. To complicate matters, some of the descriptions already had the new disclaimer applied, so I’d need to step over those to avoid duplication.
Instead of opening each file, looking for the text, and pasting it at the end of the document manually, I whipped up a good ol’ Word macro to do the trick. The VBA for such a task isn’t terribly complex or difficult to write, but Word’s object model has many idiosyncrasies to consider. It also doesn’t help that Microsoft decided to drop support for my tried and true Application.FileSearch method in Office 2007 (thanks a heap, Microsoft), which was central to my original strategy and made the recursive aspects of discovering files that might be buried in subfolders a bit more challenging.
Anyway, for all you VBA enthusiasts out there, here’s my project code:
'Require explicit variable declaration
Option Explicit
'Add disclaimer to all job descriptions
Sub AddDisclaimer()
'Local variables
Dim myFileList(1 To 65536) As String, myFolder As String, myReport As String
Dim myChange As VbMsgBoxResult
Dim myDoc As Document
Dim myFileCount As Long, i As Long
Const myDisclaimer As String = "Cooperative, positive, courteous and professional " & _
behavior and conduct is an essential function of every position. All employees must..."
'Get folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show <> 0 Then
'Store selected path
Let myFolder = .SelectedItems(1)
Else
GoTo Exit_Handler
End If
End With
'Do you want to change?
Let myChange = MsgBox("Do you want to add the disclaimer to documents?", _
vbQuestion + vbYesNo, "Confirm")
'Build list of files to check/update
Call GenerateFileList(myFolder, myFileList, myFileCount)
'For each document file in search results
For i = 1 To myFileCount
'Open file
Set myDoc = Documents.Open(myFileList(i))
'Attempt to locate the disclaimer text
With Selection.Find
.Text = Left(myDisclaimer, 100)
.Forward = True
.Wrap = wdFindContinue
.Execute
'If not found and user has chosen to add disclaimer
If .Found = False And myChange = vbYes Then
'Seek to end of document and insert text
With Selection
.EndKey wdStory
.TypeParagraph
.TypeText myDisclaimer
End With
'Update report string
myReport = "was modified."
'Save changes to document
ActiveDocument.Save
Else
'Update report string
myReport = "was not modified."
End If
'Close document
ActiveDocument.Close
End With
'Update report
With Selection
.TypeText myFileList(i) & " " & myReport
.TypeParagraph
End With
Next i
Exit_Handler:
Exit Sub
End Sub
'Generate list of all Word documents in the specified folder
Sub GenerateFileList(myFolder As String, ByRef myArray() As String, ByRef i As Long)
'Local variables
Dim myFSO As Object
Dim myFilename As String
'Lookup Word documents in myFolder
Let myFilename = Dir(myFolder & "*.doc*")
'While Dir returns filenames
Do While myFilename <> vbNullString
'Add filepath to array and lookup next file
Let i = i + 1
Let myArray(i) = myFolder & "" & myFilename
Let myFilename = Dir()
Loop
'Create file system object
Set myFSO = CreateObject("Scripting.FileSystemObject")
'Look in any subfolders
Call RecurseSubFolders(myFSO.GetFolder(myFolder), myArray(), i)
'Release file system object
Set myFSO = Nothing
End Sub
'Traverse each subfolder to build list of Word documents
Private Sub RecurseSubFolders(ByRef myFolder As Object, ByRef myArray() As String, _
ByRef i As Long)
'Local variables
Dim mySubfolder As Object
Dim myFilename As String
'For each subfolder in current folder
For Each mySubfolder In myFolder.SubFolders
'Lookup next file
Let myFilename = Dir(mySubfolder.Path & "*.doc*")
'While Dir returns filenames
Do While myFilename <> vbNullString
'Add filepath to array and lookup next file
Let i = i + 1
Let myArray(i) = mySubfolder.Path & "" & myFilename
Let myFilename = Dir()
Loop
'Look in any subfolders
Call RecurseSubFolders(mySubfolder, myArray(), i)
Next
End Sub
Let’s see OpenOffice.org Writer or Google Docs do that.
– Greg
gregsedwards 
Yes, I agree that the program is overbloated. However, in my case it’s most likely because I rarely (if ever) use/need all of those features. I have no need for them and therefore just use a basic program called AbiWord. It’s just basically word processing. If I find myself needing anything more than that, I use OpenOffice. Both of these are free and satisfy all my needs. I too have found myself more interested in and spending more time with Windows Live recently.
LikeLike
Blimey, Greg! I can follow it through, but how do you remember all that scripting, and in which order to put it? Impressive!
LikeLike
And i thought HTML was hard to read!
LikeLike
Thanks for keeping me honest, bro. Truth be told, I need to spend some more time getting under the hood of OpenOffice. If the SDK is anything like the rest of the suite, then it’ll be extremely well thought out and consistent. Nice to see you lurking round WL once in a while, Jefe!
LikeLike