VBA/Excel/Access/Word/Access/Microsoft Jet

A Simple Connection Example

 
Sub MakeConnectionExample() 
    Dim conn As ADODB.Connection 
    On Error GoTo ErrHandler 
    Set conn = New ADODB.Connection 
    conn.Provider = "Microsoft.Jet.OLEDB.4.0;" 
    conn.ConnectionString = "Data Source=" & CurrentProject.Path &"\mydb.mdb" 
    conn.Open 
    If conn.State = adStateOpen Then 
        MsgBox "Connected!", vbOKOnly 
        conn.Close 
    Else 
        MsgBox "Not connected!", vbOKCancel 
    End If 
    Set conn = Nothing 
    Exit Sub 
ErrHandler: 
    MsgBox "Could not connect to database. " & Err.Description, _ 
        vbOKOnly 
End Sub

Connection String to Access database

 
Sub AccessExample()
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    
    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.Jet.OLEDB.4.0;"
    cn.ConnectionString = "Data Source=C:\mydb.mdb"
    cn.Open
    
    Debug.Print "Full connection string: " & cn.ConnectionString
    
    Set rs = cn.OpenSchema(adSchemaTables)
    Do While Not rs.EOF
        Debug.Print rs!TABLE_NAME & "  Type: " & rs!TABLE_TYPE
        rs.MoveNext
    Loop
    rs.Close
    cn.Close
End Sub

connect to JET

 
Sub Jet()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.Jet.OLEDB.3.51"
        .ConnectionString = "data source=" & _
            App.Path & "\sample.mdb"
        .Mode = adModeRead
        .Open
    End With
    MsgBox "Connected to " & conn.Provider, vbInformation
    Set rst = New ADODB.Recordset
    rst.Open "Customers", conn
    MsgBox rst!CompanyName, vbInformation
    rst.Close
    Set rst = Nothing
End Sub

Create new database

 
Sub CreateDatabase()
    Dim cat As New ADOX.Catalog
    cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=C:\mydb.mdb;"
End Sub

Include the database version information with the JetOLEDB:Engine Type property

 
" you must make sure that a reference to
" Microsoft ADO Ext. 2.5 for DDL and Security
" Object Library is set in the References dialog box
Sub CreateI_NewDatabase()
   Dim cat As ADOX.Catalog
   Dim strDb As String
   Set cat = New ADOX.Catalog
   strDb = "C:\NewAccessDb.mdb"
   On Error GoTo ErrorHandler
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & strDb & _
    "Jet OLEDB:Encrypt Database=True;" & _
    "Jet OLEDB:Engine Type=1;"
   MsgBox "The database was created (" & strDb & ")."
   Set cat = Nothing
   Exit Sub
ErrorHandler:
   If Err.Number = -2147217897 Then
      Kill strDb
      Resume 0
   Else
      MsgBox Err.Number & ": " & Err.Description
   End If
End Sub

Open a worksheet through OLEDB

 
Sub openWorksheet()
   Dim myConnection As New ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   
   myConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=C:\Customers.xls;" & _
             "Extended Properties=Excel 8.0;"
   
   Set myRecordset = New ADODB.Recordset
   myRecordset.Open "customers", myConnection, , , adCmdTable
   
   Do Until myRecordset.EOF
      Debug.Print myRecordset("txtCustNumber"), myRecordset("txtBookPurchased")
      myRecordset.MoveNext
   Loop
End Sub

Opening a Microsoft Jet Database in Read/Write Mode

 
"Intrinsic constants of the Connection object"s Mode property 
Constant Name           Value    Type of Permission
adModeUnknown           0        Permissions have not been set yet or cannot be determined. This is the default setting.
adModeRead              1        Read-only permissions
adModeWrite             2        Write-only permissions
adModeReadWrite         3        Read/write permissions
adModeShareDenyRead     4        Prevents others from opening the connection with read permissions
adModeShareDenyWrite    8        Prevents others from opening the connection with write permissions
adModeShareExclusive    12       Prevents others from opening the connection
adModeShareDenyNone     16       Prevents others from opening the connection with any permissions

Read table schema

 
Sub ReadSchema()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data source=" & CurrentProject.Path & "\mydb.mdb"
        .Open
    End With
    Set rst = conn.OpenSchema(adSchemaTables)
    Do Until rst.EOF
        Debug.Print "Catalog: " & rst!Table_Catalog
        Debug.Print "Schema: " & rst!Table_Schema
        Debug.Print "Table Name: " & rst!Table_Name
        Debug.Print "Type: " & rst!Table_Type
        Debug.Print "Date Created: " & rst!Date_Created
        Debug.Print "Date Modified" & rst!Date_Modified
        Debug.Print
        rst.moveNext
    Loop
    rst.Close
    conn.Close
    
    Set rst = Nothing
    Set conn = Nothing
End Sub

Sub addJetSqlUser()

 
   Dim myConnection As ADODB.Connection
   Dim newUser As ADOX.User
   Dim strSQL As String
   
   Set myConnection = New ADODB.Connection
   With myConnection
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Properties("Jet OLEDB:System database") = "C:\demo.mdw"
      .Open "Data Source=c:\VBA.mdb;User ID=John;Password=;"
      strSQL = "CREATE USER joe [mycat] NULL"
      .Execute (strSQL)
   End With
End Sub

Use Recordset.Support to check the supported features

 
Sub SupportsExample()
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim lRecordsAffected As Long
    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.Jet.OLEDB.4.0;"
    cn.ConnectionString = "Data Source=C:\mydb.mdb"
    cn.Open
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseServer
    rs.Open "SELECT * FROM Names", cn, adOpenStatic, adLockOptimistic
    Debug.Print "adAddNew: " & rs.Supports(adAddNew)
    Debug.Print "adBookmark: " & rs.Supports(adBookmark)
    Debug.Print "adDelete: " & rs.Supports(adDelete)
    Debug.Print "adFind: " & rs.Supports(adFind)
    Debug.Print "adUpdate: " & rs.Supports(adUpdate)
    Debug.Print "adMovePrevious: " & rs.Supports(adMovePrevious)
    rs.Close
    rs.CursorLocation = adUseServer
    rs.Open "SELECT * FROM Names", cn, adOpenDynamic, adLockOptimistic
    Debug.Print "adAddNew: " & rs.Supports(adAddNew)
    Debug.Print "adBookmark: " & rs.Supports(adBookmark)
    Debug.Print "adDelete: " & rs.Supports(adDelete)
    Debug.Print "adFind: " & rs.Supports(adFind)
    Debug.Print "adUpdate: " & rs.Supports(adUpdate)
    Debug.Print "adMovePrevious: " & rs.Supports(adMovePrevious)
    
    rs.Close
    
    cn.Close
End Sub