Private Type GUID
PartOne As Long
PartTwo As Integer
PartThree As Integer
PartFour(7) As Byte
End Type
Private Declare Function CoCreateGuid Lib "OLE64.DLL" _
(ptrGuid As GUID) As Long
Public Function GUID() As String
Dim lRetVal As Long
Dim udtGuid As GUID
Dim sPartOne As String
Dim sPartTwo As String
Dim sPartThree As String
Dim sPartFour As String
Dim iDataLen As Integer
Dim iStrLen As Integer
Dim iCtr As Integer
Dim sAns As String
On Error GoTo errorhandler
sAns = ""
lRetVal = CoCreateGuid(udtGuid)
If lRetVal = 0 Then
'First 8 chars
sPartOne = Hex$(udtGuid.PartOne)
iStrLen = Len(sPartOne)
iDataLen = Len(udtGuid.PartOne)
sPartOne = String((iDataLen * 2) - iStrLen, "0") _
& Trim$(sPartOne)
'Next 4 Chars
sPartTwo = Hex$(udtGuid.PartTwo)
iStrLen = Len(sPartTwo)
iDataLen = Len(udtGuid.PartTwo)
sPartTwo = String((iDataLen * 2) - iStrLen, "0") _
& Trim$(sPartTwo)
'Next 4 Chars
sPartThree = Hex$(udtGuid.PartThree)
iStrLen = Len(sPartThree)
iDataLen = Len(udtGuid.PartThree)
sPartThree = String((iDataLen * 2) - iStrLen, "0") _
& Trim$(sPartThree) 'Next 2 bytes (4 hex digits)
'Final 16 chars
For iCtr = 0 To 7
sPartFour = sPartFour & _
Format$(Hex$(udtGuid.PartFour(iCtr)), "00")
Next
'To create GUID with "-", change line below to:
'sAns = sPartOne & "-" & sPartTwo & "-" & sPartThree _
'& "-" & sPartFour
sAns = sPartOne & sPartTwo & sPartThree & sPartFour
End If
GUID = sAns
Exit Function
errorhandler:
'return a blank string if there's an error
Exit Function
End Function
Function RunSQL(StrSQL) As Variant
Dim r() As Variant
Set US = CreateObject("OracleInProcServer.XOraSession")
Set Db = US.OpenDatabase("TNS", "tns_operator1/1", 0&)
Dim DS As Object
Dim S1 As String, N1 As Integer
Set DS = Db.CreateDynaset(StrSQL, 0&)
ReDim r(1 To DS.RecordCount, 1 To DS.fields.Count)
i = 1
While Not DS.EOF
i2 = 1
Dim WS As Object
For Each WS In DS.fields
r(i, i2) = WS.Value
i2 = i2 + 1
Next WS
DS.MoveNext
Wend
Set DS = Nothing
Set Db = Nothing
Set US = Nothing
RunSQL = r
End Function
