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

Материал из VB Эксперт
Версия от 15:46, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

A Simple Connection Example

   <source lang="vb">

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

</source>
   
  


Connection String to Access database

   <source lang="vb">

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

</source>
   
  


connect to JET

   <source lang="vb">

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

</source>
   
  


Create new database

   <source lang="vb">

Sub CreateDatabase()

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

End Sub

</source>
   
  


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

   <source lang="vb">

" 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

</source>
   
  


Open a worksheet through OLEDB

   <source lang="vb">

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

</source>
   
  


Opening a Microsoft Jet Database in Read/Write Mode

   <source lang="vb">

"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

</source>
   
  


Read table schema

   <source lang="vb">

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

</source>
   
  


Sub addJetSqlUser()

   <source lang="vb">

  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

</source>
   
  


Use Recordset.Support to check the supported features

   <source lang="vb">

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

</source>