Excel VBA GUIDを生成する

Excel VBA GUIDを生成する

==

Public Sub GetGUID() 
    Dim typelib As Object
    Dim guid As String
    
    Set typelib = CreateObject("Scriptlet.TypeLib")
    guid = Mid$(typelib.guid, 2, 36)
    
    ActiveCell.Value = guid
End Sub

上記でエラーとなる場合

Private Const SEP As String = ","

Private Type GUID_TYPE
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
 
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
 
Function CreateGuidString()
    Dim guid As GUID_TYPE
    Dim strGuid As String
    Dim retValue As LongPtr
    
    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
            CreateGuidString = strGuid
        End If
    End If
End Function
 
Public Sub GetGUID()
    Dim strGuid As String
    strGuid = CreateGuidString()
    
    strGuid = Replace(Replace(strGuid, "{", ""), "}", "")
    
    ActiveCell.Value = strGuid
End Sub