Generating guaranteed unique numbers in VBA

Started by Visisthebest, October 13, 2022, 09:51:40 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Visisthebest

For more purposes than just Visio Shape UniqueID's (for which Visio creates GUIDs upon your request), but also for other Visio elements sometimes a guaranteed unique number is handy to avoid potential data invalidation/corruption and other issues because of duplicate IDs.

On NoLongerSet, a great Access VBA site I found the very handy bit of code below, link:
https://nolongerset.com/createguid/

Paste it in to Visio it works right away, it does not matter how many computers are running Visio they will not generate the same GUID ever.

'These Declare lines go at the very top of the code module
#If VBA7 Then
    Private Declare PtrSafe Function CoCreateGuid Lib "ole32" (id As Any) As Long
#Else
    Private Declare Function CoCreateGuid Lib "ole32" (id As Any) As Long
#End If


' ----------------------------------------------------------------
' Procedure  : CreateGUID
' Author     : Dan (webmaster@1stchoiceav.com)
' Source     : http://allapi.mentalis.org/apilist/CDB74B0DFA5C75B7C6AFE60D3295A96F.html
' Adapted by : Mike Wolfe
' Republished: https://nolongerset.com/createguid/
' Date       : 8/5/2022
' ----------------------------------------------------------------
Public Function CreateGUID() As String
    Const S_OK As Long = 0
    Dim id(0 To 15) As Byte
    Dim Cnt As Long, GUID As String
    If CoCreateGuid(id(0)) = S_OK Then
        For Cnt = 0 To 15
            CreateGUID = CreateGUID & IIf(id(Cnt) < 16, "0", "") + Hex$(id(Cnt))
        Next Cnt
        CreateGUID = Left$(CreateGUID, 8) & "-" & _
                     Mid$(CreateGUID, 9, 4) & "-" & _
                     Mid$(CreateGUID, 13, 4) & "-" & _
                     Mid$(CreateGUID, 17, 4) & "-" & _
                     Right$(CreateGUID, 12)
    Else
        MsgBox "Error while creating GUID!"
    End If
End Function
Visio 2021 Professional