в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:46:46Z

1 версия

Новая страница

==Adding a Field with SQL command==



<source lang="vb">

Sub ADOAddField()
Dim cnn As ADODB.Connection
Dim cmd As ADODB.rumand
MyConn = "C:\mydb.mdb"
End If
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set cmd = New ADODB.rumand
Set cmd.ActiveConnection = cnn
cmd.rumandText = "ALTER TABLE tbl1 Add Column Grp Char(25)"
cmd.Execute , , adCmdText
Set cmd = Nothing
Set cnn = Nothing
End Sub
</source>

==Adding a New Field to a Table==



<source lang="vb">

Sub Add_NewFields()
Dim cat As New ADOX.Catalog
Dim myTable As New ADOX.Table
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
cat.Tables("vbexTable").Columns.Append _
"MyNewField", adWChar, 15
Set cat = Nothing
End Sub
</source>

==Adding a New Money type Field to an Existing Table==



<source lang="vb">

Sub AddNewField()
Dim conn As ADODB.Connection
Dim strTable As String
Dim strCol As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
strCol = "newColumn"
conn.Execute "ALTER TABLE " & strTable & " ADD COLUMN " & strCol & " MONEY;"
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Append new columns to new table==



<source lang="vb">

Sub CreateTable()

Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table

cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\mydb.mdb;"

" Assign table name and some columns
With tbl
.Name = "NewTable"
.Columns.Append "Column1", adVarWChar, 250
.Columns.Append "Column2", adInteger
.Columns.Append "Column3", adInteger
End With

cat.Tables.Append tbl
End Sub
</source>

==Changing the Field Data Type with SQL command==



<source lang="vb">

Sub ChangeFieldType()
Dim conn As ADODB.Connection
Dim strTable As String
Dim strCol As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
strCol = "ID"
conn.Execute "ALTER TABLE " & strTable & " ALTER COLUMN " & strCol & " CHAR(15);"
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Changing the Size of a Field with SQL command==



<source lang="vb">

Sub ChangeFieldSize()
Dim conn As ADODB.Connection
Dim strTable As String
Dim strCol As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
strCol = "Name"
conn.Execute "ALTER TABLE " & strTable & " ALTER COLUMN " & strCol & " CHAR(40);"
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Changing the Start (Seed) Value of the AutoNumber Field with SQL command==



<source lang="vb">

Sub ChangeAutoNumber()
Dim conn As ADODB.Connection
Dim strDb As String
Dim strConnect As String
Dim strTable As String
Dim strCol As String
Dim intSeed As Integer
On Error GoTo ErrorHandler
strDb = CurrentProject.Path & "\" & "mydb.mdb"
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & strDb
strTable = "myTable"
strCol = "Id"
intSeed = 1000
Set conn = New ADODB.Connection
conn.Open strConnect
conn.Execute "ALTER TABLE " & strTable & " ALTER COLUMN " & strCol & " COUNTER (" & intSeed & ");"
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
If Err.Number = -2147467259 Then
Debug.Print "The database file cannot be located.", _
vbCritical, strDb
Exit Sub
Else
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End If
End Sub
</source>

==Checking for Existence of a Field==



<source lang="vb">

Function ColumnExists(WhichColumn, WhichTable)
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim WSOrig As Worksheet
Dim WSTemp As Worksheet
Dim fld As ADODB.Field
ColumnExists = False
MyConn = MyConn & "\mydb.mdb"
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With
Set rst = cnn.OpenSchema(adSchemaColumns)
Do Until rst.EOF
If LCase(rst!Column_Name) = LCase(WhichColumn) And _
LCase(rst!Table_Name) = LCase(WhichTable) Then
ColumnExists = True
GoTo ExitMe
End If
rst.MoveNext
Loop
ExitMe:
rst.Close
Set rst = Nothing
cnn.Close
End Function
</source>

==Delete a column==



<source lang="vb">

Sub ChangeColumn()
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table

cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\mydb.mdb;"
Set tbl = cat.Tables("Newtable")
tbl.Columns("Column2").Name = "Column2X"
tbl.Columns.Delete "Column3"
End Sub
</source>

==Deleting a Field from a Table with SQL command==



<source lang="vb">

Sub DeleteField()
Dim conn As ADODB.Connection
Dim strTable As String
Dim strCol As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
strCol = "myCol"
conn.Execute "ALTER TABLE " & strTable & " DROP COLUMN " & strCol & ";"
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Get field properties==



<source lang="vb">

Public Sub DescribeARow()
Const SQL As String = "SELECT * FROM Customers"
Const ConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydb.mdb;Persist Security Info=False"
Dim Recordset As Recordset
Set Recordset = New Recordset
Call Recordset.Open(SQL, ConnectionString, adOpenDynamic)
Recordset.MoveFirst
Dim Field As Field
For Each Field In Recordset.Fields
Debug.Print "Name: " & Field.Name
Debug.Print "Type: " & Field.Type
Debug.Print "Size: " & Field.ActualSize
Debug.Print "Value: " & Field.Value
Next
End Sub
</source>

==Listing Field Properties==



<source lang="vb">

Sub List_FieldProperties()
Dim cat As ADOX.Catalog
Dim col As ADOX.Column
Dim pr As ADOX.Property
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = CurrentProject.Connection
Set col = New ADOX.Column
Set col = cat.Tables("vbexTable").Columns("Id")
MsgBox col.Properties.Count
For Each pr In col.Properties
Debug.Print pr.Name & "="; pr.Value
Next
Set cat = Nothing
End Sub
</source>

==Listing Tables and Their Fields Using the OpenSchema Method==



<source lang="vb">

Sub ListTblsAndFields()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim curTable As String
Dim newTable As String
Dim counter As Integer
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
Set rst = conn.OpenSchema(adSchemaColumns)
curTable = ""
newTable = ""
counter = 1
Do Until rst.EOF
curTable = rst!table_Name
If (curTable <> newTable) Then
newTable = rst!table_Name
Debug.Print "Table: " & rst!table_Name
counter = 1
End If
Debug.Print "Field" & counter & ": " & rst!Column_Name
counter = counter + 1
rst.MoveNext
Loop
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub
</source>

==Open a table and read data by column==



<source lang="vb">

Sub LoopProjects()
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "Employees", CurrentProject.Connection
Do Until rst.EOF
Debug.Print rst!Title, rst!City
If IsNull(rst!Region) Then
Debug.Print "No Value!!"
End If
rst.MoveNext
Loop
End Sub
</source>

==Read record in recordset by referening the field name with "!"==



<source lang="vb">

Public Sub Loops()
Dim con As ADODB.Connection
Dim rs As New ADODB.Recordset
Set con = New ADODB.Connection

con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\store.mdb;"

rs.CursorLocation = adUseServer
rs.Open "SELECT * FROM Employees", con, adOpenStatic, adLockOptimistic

Do While Not rs.EOF
Dim strName As String
Debug.Print rs!txtCustFirstName & " " & rs!txtCustLastName
rs.MoveNext
Loop
Debug.Print rs.RecordCount & " records: "

Set rs = Nothing
Set con = Nothing
End Sub
</source>

==Read specific columns from Recordset==



<source lang="vb">

Sub MyFirstConnection()
Dim myConnection As ADODB.Connection
Dim myRecordset As ADODB.Recordset
Dim strSQL As String

strSQL = "SELECT FirstName, LastName FROM Employees"

Set myConnection = CurrentProject.Connection

Set myRecordset = New ADODB.Recordset
myRecordset.Open strSQL, myConnection

Do Until myRecordset.EOF
Debug.Print myRecordset.Fields("FirstName") & " " & myRecordset.Fields("LastName")
myRecordset.moveNext
Loop
myRecordset.Close
myConnection.Close
Set myConnection = Nothing
Set myRecordset = Nothing
End Sub
</source>

==Removing a Field from a Table==



<source lang="vb">

Sub Delete_Field()
Dim cat As New ADOX.Catalog
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
cat.Tables("vbexTable").Columns.Delete "Type"
Set cat = Nothing
End Sub
</source>

==Set column properties by using ADOX.Table==



<source lang="vb">

ADO Equivalents to Access Data Types

Microsoft Access Data Type ADO Equivalent
Binary adBinary
Boolean adBoolean
Byte adUnsignedTinyInt
Currency adCurrency
Date adDate
Numeric adNumeric
Double adDouble
Small Integer adSmallInt
Integer adInteger
Long Binary adLongBinary
Memo adLongVarWChar
Single adSingle
Text adWChar

Sub makeTable()
Dim currCat As New ADOX.Catalog
Dim newTable As New ADOX.Table
Dim newKey As New ADOX.Key

currCat.ActiveConnection = CurrentProject.Connection

With newTable
.Name = "tblTestTable"
.Columns.Append "custNumber", adInteger
.Columns("custNumber").ParentCatalog = currCat
.Columns("custNumber").Properties("AutoIncrement") = True

newKey.Name = "PrimaryKey"
newKey.Columns.Append "custNumber"
.Keys.Append newKey, adKeyPrimary

.Columns.Append "custFirstName", adWChar
.Columns.Append "custLastName", adWChar
End With

currCat.Tables.Append newTable

Set currCat = Nothing
End Sub
</source>

==Setting a Default Value for a Field with SQL command==



<source lang="vb">

Sub SetDefaultFieldValue()
Dim conn As ADODB.Connection
Dim strTable As String
Dim strCol As String
Dim strDefVal As String
Dim strSQL As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
strCol = "City"
strDefVal = "Boston"
strSQL = "ALTER TABLE " & strTable & _
" ALTER " & strCol & " SET DEFAULT " & strDefVal
conn.Execute strSQL
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Show field name, type and value data type==



<source lang="vb">

Sub rec_fields()
Dim conn As New Connection
Dim rec As New Recordset
Dim f As Field
Dim ws As Worksheet
Dim i&
Set ws = ThisWorkbook.Worksheets("fields")
conn.Open "Provider=microsoft.jet.oledb.4.0;" + _
"Data Source=" + ThisWorkbook.Path + "\nwind.mdb;"
rec.Open "employees", conn
For Each f In rec.Fields
i = i + 1
ws.[a1].Cells(i) = f.Name
ws.[b1].Cells(i) = f.Type
ws.[c1].Cells(i) = TypeName(f.Value)
Next
rec.Close: conn.Close
End Sub
</source>

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

VBA/Excel/Access/Word/Access/Table Column Field - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия