Krasnoarmeec

Option Explicit

Private Declare Function CoCreateGuid Lib "ole32" (pguid As GUID) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (rguid As GUID, ByVal lpsz As Long, ByVal cchMax As Long) As Long

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Const DBname = "TestDB.mdb"

Sub CreateNewMdb()
    Dim Catalog As Object
    Set Catalog = CreateObject("ADOX.Catalog")
    Catalog.Create ("Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & "D:\TMP\TestDB.mdb;")
End Sub

Sub CreateTblInDb()
    Dim adoConnection As ADODB.Connection
    Set adoConnection = New ADODB.Connection
    adoConnection.Open connectionString
    
    adoConnection.Execute ("CREATE TABLE tblDemoTable ([Product name] varchar(50), [Product ID] varchar(10), [Product Price] decimal)")
    adoConnection.Execute ("INSERT INTO tblDemoTable ([Product name], [Product ID], [Product Price]) VALUES ('Product one', '123', '3.45')")
End Sub

Sub GetRecords()
    Dim adoConnection As ADODB.Connection
    Dim SqlString$, connectionString$
    
    connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ExcelPath & "\" & DBname & ";"
    
    Set adoConnection = New ADODB.Connection
    adoConnection.Open connectionString
    adoConnection.Execute ("INSERT INTO tblDemoTable ([Product name], [Product ID], [Product Price]) VALUES ('Product two', '234', '3,45')")
    
    Dim rst As New ADODB.Recordset
    
    SqlString = "SELECT * FROM tblDemoTable;"
'    SqlString = "Select * From tblDemoTable WHERE 'Product ID' = '123';"
    rst.Open SqlString, adoConnection, adOpenForwardOnly, adLockReadOnly
    Dim x&, fld As ADODB.Field
    x = 0
    For Each fld In rst.Fields
        Cells(1, x + 1) = fld.Name
        x = x + 1
    Next fld
    
    Range("A2").CopyFromRecordset rst
    
    rst.Close
    Set rst = Nothing
    adoConnection.Close
    Set adoConnection = Nothing
    
    Dim guid1$
    guid1 = CreateGUID
End Sub

Sub Test()
    ListAccessTables (ExcelPath & "\" & DBname)
End Sub

Sub ListAccessTables(strDBPath)
    Dim cnnDB As ADODB.Connection
    Dim rstList As ADODB.Recordset
    
    Set cnnDB = New ADODB.Connection
    
    ' Open the connection.
    With cnnDB
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open strDBPath
    End With
    
    ' Open the tables schema rowset.
    Set rstList = cnnDB.OpenSchema(adSchemaTables)
    
    ' Loop through the results and print the
    ' names and types in the Immediate pane.
    With rstList
        Do While Not .EOF
            If .Fields("TABLE_TYPE") <> "VIEW" And .Fields("TABLE_TYPE") <> "SYSTEM TABLE" Then
                Debug.Print .Fields("TABLE_NAME")
            End If
            .MoveNext
        Loop
    End With
    
    cnnDB.Close
    Set cnnDB = Nothing
End Sub

Function ExcelPath()
    ExcelPath = Application.ActiveWorkbook.Path
End Function

Public Function CreateGUID() As String
  Dim NewGUID As GUID
  CoCreateGuid NewGUID
  CreateGUID = Space$(38)
  StringFromGUID2 NewGUID, StrPtr(CreateGUID), 39
  CreateGUID = Replace(Replace(CreateGUID, "}", ""), "{", "")
End Function