VBA TUTOR NEWSLETTER ~ TUTORIAL EIGHT: Saving data into a WORD table to be used by other macros

>GRSoftware >VBA Tutor >Newsletter Tutorials >Tutorial 7 >Tutorial 9

VBA TUTOR NEWSLETTER ~ TUTORIAL EIGHT:
Saving data into a WORD table to be used by other macros

If you find yourself doing repetative tasks in WORD, these can be automated by saving the data you are using into a table in a seperate WORD document. This data can then be used by another macro to "automate" your work.

In the following example, we will save some "find and replace" text into a table in a WORD document called 'Dictionary.doc'. Obviously, checking for duplicate entries will need to be made. This is done by a simple step though each table row. Notice how the table is first sorted after a new addition is made to make it easier to check and maintain.

STEP ONE: Create the neccessary functions.

'This function removes the 'extra' two characters added by WORD when data is written into a table.
Public Function cleanTableText(text) As String
Dim SLength
SLength = Len(text)
cleanTableText = Left(text, (SLength - 2))
End Function

'This function is passed a string, a file name, but returns a Boolean value, "True" or "False".
Public Function isFileOpen(file) As Boolean
Dim doc
isFileOpen = False
For Each doc In Documents
If doc.Name = file Then isFileOpen = True
Next doc
End Function

'This function is not "really" neccessary, but gives you a coding example of how to open a file and test that it did open.
Public Function OpenDoc(file) As Boolean
On Error Resume Next
Documents.Open FileName:=CurDir + "/" + file
OpenDoc = isFileOpen(file)
End Function

STEP TWO: Collect and record the "find" and "replace" text data.

Sub saveFindReplace()
Dim wFind, wReplace, myTable, myRange, Found, RCount, RIndex, TempwFind
'Set the data files as a contant, so it is easy to change the name at a later stage.
Const file as string = "Dictionary.doc"
'First right trim then left trim the selected text as it is set to the variable wFind
wFind = RTrim(Selection)
wFind = LTrim(wFind)
'Try to open the data file. If unsuccessful, ask the user to find and open it.
On Error Resume Next
if isFileOpen(file) = False Then
OpenDoc(file)
End If
if isFileOpen(file) = False Then
Dialogs(wdDialogFileOpen).Show
End If
'If the data file is still not open, then exit.
if isFileOpen(file) = False Then
msgbox "'"+file+"' is not open!"
Exit Sub
End If
'If file is open, ask for replacement text.
wReplace = InputBox(" ", "Enter Text in wReplace to Replace Selected Text")
'Check to see if any text was entered
If wReplace = "" Then
MsgBox "You must enter some text!"
Exit Sub
End If
'If replacement text entered, first right trim, then left trim it.
wReplace = RTrim(wReplace)
wReplace = LTrim(wReplace)
'Turn screen updating off.
Application.ScreenUpdating = False
'Set the range to the whole document
Set myRange = ActiveDocument.Content
'Run the replacement object.
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = wFind
.Replacement.Text = wReplace
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
'Set a table object to the table in "Dictionary.doc".
Set myTable = Documents(file).Tables(1)
'Find the number of rows in the table.
RCount = myTable.Rows.Count + 1
'Start after the Heading (We must be neat!)
RIndex = 2
'Reinitialise the "Found" boolean variable
Found = False
'Work down each row, first reading then left trimming the text in the table.
While RIndex < RCount
TempwFind = cleanTableText(myTable.Cell(RIndex, 1)
'If a duplicate is found, then give a message, then set the boolean "Found" variable to "true".
If TempwFind = wFind Then
MsgBox "Duplicate found! This translation pair will not be added to 'Dictionary.doc'!"
Found = True
End If
'Increment the row index variable.
RIndex = RIndex + 1
Wend
'If new text is not found, then add it to the table.
If Found <> True Then
myTable.Rows.Add
myTable.Cell(myTable.Rows.Count, 1) = wFind
myTable.Cell(myTable.Rows.Count, 2) = wReplace
'Then sort the table.
If myTable.Rows.Count > 2 Then
myTable.sort ExcludeHeader:=True
End If
'Save the table.
Documents(file).Save
End If
'Turn screen updating back on.
Application.ScreenUpdating = True
'Release the allocated resources.
Set myTable = Nothing
Set myRange = Nothing
'Remove the selection highlighting.
Selection.Collapse
End Sub

STEP THREE:
This code demonstrates the concept of using data saved into a WORD table so that many changes can be made in one hit.
NOTE: This concept can be be applied to EXCEL worksheets just as well.

Option Explicit
Sub useDictionaryData()
Dim curFile, wFind, wReplace, myTable, RCount, RIndex, myRange
Const file as string = "Dictionary.doc"
curFile = ActiveDocument.Name
'Check to see if "Dictionary.doc" is open. If not, ask user to open.
On Error Resume Next
if isFileOpen(file) = False Then
OpenDoc(file)
End If
if isFileOpen(file) = False Then
Dialogs(wdDialogFileOpen).Show
End If
if isFileOpen(file) = False Then
msgbox "'Dictionary.doc' is not open!"
Exit Sub
End If
Documents(curFile).Activate
'Turn screen updating off.
Application.ScreenUpdating = False
'Set a table object to the table in "Dictionary.doc".
Set myTable = Documents(file).Tables(1)
'Find out how many rows are in the table.
RCount = myTable.Rows.Count
'Set the first row to "1".
RIndex = 1
'Count through the rows in the table.
While RIndex < RCount
'Increment the counter.
RIndex = RIndex + 1
'Get the "find" text from the data file and clean it.
wFind=cleanTableText(myTable.Cell(RIndex, 1)
'Get the "replace" text from the data file and clean it.
wReplace = cleanTableText(myTable.Cell(RIndex, 2))
'Set the range to the whole document.
Set myRange = ActiveDocument.Content
'Run the replacement object.
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = wFind
.Replacement.Text = wReplace
.MatchWholeWord = True
.Execute Replace:=wdReplaceAll
End With
Wend
'Turn screen updating back on.
Application.ScreenUpdating = True
'Release the allocated resources.
Set myRange = Nothing
Set myTable = Nothing
End Sub

EXERCISE:
* Remove the "wFind" and "wReplace" variables in the "useDictionaryData" macro.

HOPEFULLY, THESE CODE EXAMPLES WILL ADD TO YOUR ABILITY TO BECOME A VBA POWER USER!