GUID on VBA

BIM got this thing of GUID to reference the different elements/components inside the file.

But somewhen in the future, I’ll need to get my own GUID function to reference elements.

In Excel is a bit hard to produce via function with this formula:

= CONCATENATE(DEC2HEX(RANDBETWEEN(0,4294967295),8),"-",DEC2HEX(RANDBETWEEN(0,6553??5),4),"-",DEC2HEX(RANDBETWEEN(16384,20479),4),"-",DEC2HEX(RANDBETWEEN(32768,49151??),4),"-",DEC2HEX(RANDBETWEEN(0,65535),4),DEC2HEX(RANDBETWEEN(0,4294967295),8))

To get a more consistent method, we can rely on VBA. Here is the code:

' No VT_GUID available so must declare type GUID
Private Type GUID_TYPE
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (Guid As GUID_TYPE) As LongPtr
    Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (Guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr

    Public Function GenerateGUID() As String
        Dim Guid As GUID_TYPE
        Dim strGuid As String
        Dim retValue As Long 'Ptr
        Const guidLength As Long = 39 'registry GUID format with null terminator {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}
    
        retValue = CoCreateGuid(Guid)
        If retValue = 0 Then
            strGuid = String$(guidLength, vbNullChar)
            retValue = StringFromGUID2(Guid, StrPtr(strGuid), guidLength)
            If retValue = guidLength Then
                ' valid GUID as a string
                GenerateGUID = strGuid
            End If
        End If
    End Function
#Else
    Private Declare Function CoCreateGuid Lib "ole32" (ByRef Guid As Byte) As Long

    Public Function GenerateGUID() As String
        Dim ID(0 To 15) As Byte
        Dim N As Long
        Dim Guid As String
        Dim Res As Long
        
        Res = CoCreateGuid(ID(0))
        For N = 0 To 15
            Guid = Guid & IIf(ID(N) < 16, "0", "") & Hex$(ID(N))
            If Len(Guid) = 8 Or Len(Guid) = 13 Or Len(Guid) = 18 Or Len(Guid) = 23 Then
                Guid = Guid & "-"
            End If
            Next N
        GenerateGUID = Guid
    End Function

    'Private Declare Function CoCreateGuid_2 Lib "ole32" (ByRef Guid As GUID_TYPE) As Long
    'Public Function NewGUID() As String
    ''(c) 2000 Gus Molina
    '' Not working!
    '
    '    Dim udtGUID As GUID_TYPE
    '
    '    If (CoCreateGuid_2(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
#End If

Public Sub sGenerateGUID()
    MsgBox GenerateGUID ' NewGUID
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *