トップ 差分 一覧 ping ソース 検索 ヘルプ PDF RSS ログイン

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



YAGI Hiroto (piroto@a-net.email.ne.jp)
twitter http://twitter.com/pppiroto

Copyright© 矢木 浩人 All Rights Reserved.