в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:46:43Z

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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Access/Microsoft Jet - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия