Count Template Usage

[Lee Kiwiflame]

I need to count how many times each template is used. I want the count to
write to one file only.

The below code counts what templates each person is using but I want to
count how many times each template is accessed, i.e. each time someone uses a
template, a file is opened, the code looks to see if that template name is in
the file, if it is then it adds 1 to the total. If the name is not in the
file, then it writes the template name and 1.

'<----------------------Start of Module Code---------------------------->
Option Explicit

Public gccTemplateUsageCounter As clsCounter

Public Sub AutoExec()

Dim strUserName As String, cCounterFileFullPath As String

strUserName = Environ$("Username")

cCounterFileFullPath = "M:\TECHNOLOGY\TemplateUsage\CountUsage\" &
strUserName & "_count_usage.cnt"

' Instantiate class to perform template usage counting
Set gccTemplateUsageCounter = New clsCounter

' Hook up event handler to that we can catch application level events
Set gccTemplateUsageCounter.appWord = Word.Application

' Log the existing counter file (if any)
gccTemplateUsageCounter.Initialise cCounterFileFullPath
End Sub


<------------------------Start of Class Module
Code----------------------------->
Option Explicit

Private Const mcInitialSize As Long = 50
Private Const mcIncrementSize As Long = 10

Private Type UsageCounter
Template As String
Count As Long
End Type

Public WithEvents appWord As Word.Application

Private maucCounters() As UsageCounter
Private mlngCountersMax As Long
Private mstrCounterFile As String

Public Sub Initialise(ByVal strCounterFile As String)
Dim lngIndex As Long
Dim strData As String
Dim astrData() As String

' Set array to it's initial sizing
ReDim maucCounters(0 To mcInitialSize - 1) As UsageCounter
mlngCountersMax = -1

' Save the counter file name for when we need to update it
mstrCounterFile = strCounterFile

' Read the counter file and load the contents into the array
strData = ReadFile(strCounterFile)

' Parse the counter file a line at a time
astrData = Split(strData, vbCrLf)
For lngIndex = 0 To UBound(astrData)

' Now parse out the data: Path, Template, Counter
AddExistingCounter astrData(lngIndex)
Next

' Make sure the array if not too flabby
If mcInitialSize - mlngCountersMax > mcIncrementSize - 1 Then
ReDim Preserve maucCounters(0 To mlngCountersMax + mcIncrementSize)
End If
End Sub

Private Sub appWord_NewDocument(ByVal Doc As Document)

' Count the usage of the current template
CountCurrentTemplate Doc.AttachedTemplate
End Sub

Private Function ReadFile(ByVal strInputFile As String) As String
Dim strInput As String
Dim hFile As Long

' Next available file number
hFile = FreeFile

' Open and read the entire file
Open strInputFile For Binary Access Read Shared As hFile
ReadFile = Input(LOF(hFile), hFile)

' All done - so close the file
Close hFile
End Function

Private Sub WriteFile(ByRef rstrData As String)
Dim hFile As Long

' Next available file number
hFile = FreeFile

' Open and write the entire file
Open mstrCounterFile For Binary Access Write Shared As hFile
Put hFile, , rstrData

' All done - so close the file
Close hFile
End Sub

Private Sub AddExistingCounter(ByVal strData As String)
Dim astrDatum() As String

' The array must be large enough to hold the data
MakeSpaceInArray

' Parse out the data (FullPath, Counter) and add it to the array
astrDatum = Split(strData, ",")
With maucCounters(mlngCountersMax)
.Template = astrDatum(0)
.Count = CLng(astrDatum(1))
End With
End Sub

Private Sub CountCurrentTemplate(ByVal tplTemplate As Word.Template)
Dim lngIndex As Long
Dim boolFound As Boolean

' Try to locate and use an existing counter before creating a new one
If mlngCountersMax >= 0 Then
For lngIndex = 0 To mlngCountersMax
With maucCounters(lngIndex)
If StrComp(.Template, tplTemplate.FullName, vbTextCompare) =
0 Then
.Count = .Count + 1
boolFound = True
End If
End With
Next
End If

' Add a new counter
If boolFound = False Then

' The array must be large enough to hold the data
MakeSpaceInArray
With maucCounters(mlngCountersMax)
.Template = tplTemplate.FullName
.Count = .Count + 1
End With
End If

' Save the template usage count information
SaveCounterInformation
End Sub

Private Sub MakeSpaceInArray()

' Make sure the array is large enough to hold the next piece of data
' if not then increase its size by the specified increment size
mlngCountersMax = mlngCountersMax + 1
If mlngCountersMax > UBound(maucCounters) Then
ReDim Preserve _
maucCounters(0 To UBound(maucCounters) + mcIncrementSize) As
UsageCounter
End If
End Sub

Private Sub SaveCounterInformation()
Dim lngIndex As Long
Dim strData As String

' Concatenate all data into one string, separate the Template
' and Counter using a comma and each line using vbCr
If mlngCountersMax >= 0 Then
For lngIndex = 0 To mlngCountersMax
With maucCounters(lngIndex)
If lngIndex > 0 Then
strData = strData & (vbCrLf & .Template & "," &
CStr(.Count))
Else
strData = (.Template & "," & CStr(.Count))
End If
End With
Next
End If

' Write the data to the counter file
WriteFile strData
End Sub

Any help would be appreciated. Thanks