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