Use VBA macro to rename Word document with Guid when opened

One thing I don't like about SharePoint Document Libraries is that when you try to save a document from a template, it always uses the existing template name. This means that you must rename it if you don't want to overwrite an existing document. I have come up with a simple solution that checks to see if the document template name is being used and if so renames the document with a Guid. If an existing document is opened, the document is not renamed since it is not using the template name.

 

1.  From the Developer tag click on the Visual Basic button.

2.  Click on ThisDocument under Project --> Microsoft Word Objects and add the following code:

Private Sub Document_Open()

    If ActiveDocument.Name = "Doc1.docm" Then 'Change this name to whatever the template name is.

        ActiveDocument.SaveAs FileName:=GetGUID() & ".docm"

    End If

End Sub

3.  Right-click on Project and Insert Module (not Class Module) and add the following code:

(Note: Taken from the following:  http://support.microsoft.com/kb/176790)

Private Type GUID

Data1 As Long

Data2 As Integer

Data3 As Integer

Data4(7) As Byte

End Type

Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Public Function GetGUID() As String

Dim udtGUID As GUID

If (CoCreateGuid(udtGUID) = 0) Then

GetGUID = _

String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _

String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _

String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _

IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _

IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _

IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _

IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _

IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _

IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _

IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _

IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7))

End If

End Function

 

Note: For an interesting discussion of Guid duplicate probability, see the following article.

Random UUID probability of duplicates

"...only after generating 1 billion UUIDs every second for the next 100 years, the probability of creating just one duplicate would be about 50%. The probability of one duplicate would be about 50% if every person on earth owns 600 million UUIDs."