Implement auto-increment with Word macro - vba

Question

I'm writing a Word/VBA macro for a document template. Every time a user saves/creates a new document from the template, the document needs an ID embedded in the text. How can I (as simple as possible) implement auto-increment for this ID? The ID is numeric.
The system has to have some kind of mechanism to avoid different documents getting the same IDs, but the load is very low. About 20 people will use this template (on our intranet), creating something like 20 new documents a week altogether.
I've toyed with the idea of having a text file that I lock and unlock from the macro, or call a PHP page with an SQLite database, but is there other, smarter solutions?
Note that I can't use UUID or GUID, since the IDs need to be usable by humans as well as machines. Our customers must be able to say over the phone: "... and about this, then, with ID 436 ...?"

Answer 1

Gave some further thought to this, and here is another approach you may want to consider. If you're not interested in a catalog of previous IDs, then you could simply use a custom document property to store the last ID that was used.
In Word 97-2003, you can add a custom property by going to "File / Properties", choosing the custom tab and assigning a name and value there. Adding a custom document property in Word 2007 is a bit more buried and off the top of my head, I think it's "Office Button / Prepare / Document Properties", choose the little drop down box for advanced properties and you'll get the same ol' pre-2007 dialog.
In the example below, I called mine simply "DocumentID" and assigned it an initial value of zero.
The relevant bit of code to update a Custom document property is:
ThisDocument.CustomDocumentProperties("DocumentID").Value = NewValue
As a proof of concept, I created a .dot file and used the following code in the Document_New() event:
Sub UpdateTemplate()
Dim Template As Word.Document
Dim NewDoc As Word.Document
Dim DocumentID As DocumentProperty
Dim LastID As Integer
Dim NewID As Integer
'Get a reference to the newly created document
Set NewDoc = ActiveDocument
'Open the template file
Set Template = Application.Documents.Open("C:\Doc1.dot")
'Get the custom document property
Set DocumentID = Template.CustomDocumentProperties("DocumentID")
'Get the current ID
LastID = DocumentID.Value
'Use any method you need for determining a new value
NewID = LastID + 1
'Update and close the template
Application.DisplayAlerts = wdAlertsNone
DocumentID.Value = NewID
Template.Saved = False
Template.Save
Template.Close
'Remove references to the template
NewDoc.AttachedTemplate = NormalTemplate
'Add your ID to the document somewhere
NewDoc.Range.InsertAfter ("The documentID for this document is " & NewID)
NewDoc.CustomDocumentProperties("DocumentID").Value = NewID
End Sub
Good luck!

Answer 2

You could handle this entirely through VBA using Word and Excel (or Access I suppose, but I have an unnatural aversion towards using Access).
First, create a new Excel workbook and store it in a location that you can access through your word document (mine is C:\Desktop\Book1.xls). You may even want to seed the values by entering a numeric value into cell A1.
In your word document, you would enter this into your Document_Open() subroutine:
Private Sub Document_Open()
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlRange As Excel.Range
Dim sFile As String
Dim LastID As Integer
Dim NewID As Integer
'Set to the location of the Excel "database"
sFile = "C:\Desktop\Book1.xls"
'Set all the variables for the necessary XL objects
Set xlApp = New Excel.Application
Set xlWorkbook = xlApp.Workbooks.Open(sFile)
'The used range assumes just one column in the first worksheet
Set xlRange = xlWorkbook.Worksheets(1).UsedRange
'Use a built-in Excel function to get the max ID from the used range
LastID = xlApp.WorksheetFunction.Max(xlRange)
'You may want to come up with some crazy algorithm for
'this, but I opted for the intense + 1
NewID = LastID + 1
'This will prevent the save dialog from prompting the user
xlApp.DisplayAlerts = False
'Add your ID somewhere in the document
ThisDocument.Range.InsertAfter (NewID)
'Add the new value to the Excel "database"
xlRange.Cells(xlRange.Count + 1, 1).Value = NewID
'Save and close
Call xlWorkbook.Save
Call xlWorkbook.Close
'Clean Up
xlApp.DisplayAlerts = True
Call xlApp.Quit
Set xlWorkbook = Nothing
Set xlApp = Nothing
Set xlRange = Nothing
End Sub
I realize this is a tall procedure, so by all means re-factor it to your heart's content. This was just a quick test I whipped up. Also, you'll need to add a reference to the Excel Object Library through References in VBA. Let me know if you have any questions about how that works.
Hope that helps!

Answer 3

Well you have to store the next ID number somewhere. The text file idea is as good as any. You just have to handle the possibility of it being locked or unaccessible for some reason.
Using a database for one number is overkill.

Answer 4

Off the top of my head:
Use Excel as your external DB with Automation.
Explore the several SQLite COM wrappers (Litex comes to mind).

Answer 5

"text file that I lock and unlock from the macro" would be the safest approach.
The DOCID file would only have one number: the last ACTUALLY used ID.
A) You read the file (not in write/append mode) and store on a variable on your document DOC_ID =FILE_ID+1 and save the doc. Tentatively you kill the DOCID file, open/create for read-write sotring your DOC_ID. Close the file. If all went well including Close, you're safe, otherwise, back to A).
You might want to consider: if no file is found create it with this document ID +100, as a measure of recovering from no-UPS disasters whilst in A)
I'm too tired to check if it might create a deadlock under concurrency scenario... it might.
If you feel its worth it, I can put code here.

Answer 6

It seems I found a way to open and update a text file with exclusive rights, which means that there will be no concurrency problems:
Private Function GetNextID(sFile As String) As Integer
Dim nFile As Integer
nFile = FreeFile
On Error Resume Next
Open sFile For Binary Access Read Write Lock Read Write As #nFile
If Err.Number <> 0 Then
' Return -1 if the file couldn't be opened exclusively
GetNextID = -1
Err.Clear
Exit Function
End If
On Error GoTo 0
GetNextID = 1 + Val(Input(LOF(nFile), #nFile))
Put #nFile, 1, CStr(GetNextID)
Close #nFile
End Function
Simply call this function until it doesn't return -1 anymore. Neat.