VBA/Excel/Access/Word/Access/Table Column Field
Содержание
- 1 Adding a Field with SQL command
- 2 Adding a New Field to a Table
- 3 Adding a New Money type Field to an Existing Table
- 4 Append new columns to new table
- 5 Changing the Field Data Type with SQL command
- 6 Changing the Size of a Field with SQL command
- 7 Changing the Start (Seed) Value of the AutoNumber Field with SQL command
- 8 Checking for Existence of a Field
- 9 Delete a column
- 10 Deleting a Field from a Table with SQL command
- 11 Get field properties
- 12 Listing Field Properties
- 13 Listing Tables and Their Fields Using the OpenSchema Method
- 14 Open a table and read data by column
- 15 Read record in recordset by referening the field name with "!"
- 16 Read specific columns from Recordset
- 17 Removing a Field from a Table
- 18 Set column properties by using ADOX.Table
- 19 Setting a Default Value for a Field with SQL command
- 20 Show field name, type and value data type
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>