求助！！！添加字段（关于fields.append 方法的使用）

Question

我没看你的，因为我初学，可能看不懂。但是我朋友发给过我1个类似的东西，希望对你有帮助或启发。   '先引用 Microsoft ActiveX Data Objects 2.x Library
   Dim ADO_Rset As New ADODB.Recordset
   Dim AdoStr As String
   '如果你的数据库不是 2000或以上的.那么Microsoft.Jet.OLEDB应该是3.0
   AdoStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\test.mdb;Persist Se
curity Info=False"
   With ADO_Rset
      .ActiveConnection = AdoStr
      .CursorLocation = adUseClient
      .CursorType = adOpenStatic
      .LockType = adLockBatchOptimistic
      '修改"姓名"字段
      .Source = "ALTER TABLE 学生 ALTER COLUMN 姓名 text(30)"
      .Open
      '增加"性别"字段
      .Source = "ALTER TABLE 学生 ADD 性别 text(20)"
      .Open
      '删除"籍贯"字段
      .Source = "ALTER TABLE 学生 DROP COLUMN 籍贯"
      .Open
   End With
   Set ADO_Rset = Nothing

Answer 1

to hanchileilei (寒池蕾蕾) 
"但我找不到CursorLocation属性，请问应该怎么解决？"
这样做
Dim myrs As Recordset
myrs.CursorLocation = adUseClient
    Set myrs = myDB.OpenRecordset("select * from 对象录")  '建立对象集

Answer 2

to ahzxcz(audio):
Dim myrs As Recordset
myrs.CursorLocation = adUseClient
    Set myrs = myDB.OpenRecordset("select * from 对象录")  
呜呜，没有找到这个属性

Answer 3

Dim myDB As Database
    Set myDB = Workspaces(0).OpenDatabase(App.Path & "\分析对象.mdb")   '打开数据库
    Dim myTB As TableDef
    Set myTB = myDB.TableDefs(0)                     '打开表
    Dim myFd As Field
    Set myFd = myTB.CreateField("热量", dbSingle, 2) '添加字段
        myTB.Fields.Append myFd                      '保存字段
    myDB.TableDefs.Refresh                           '更新表
    myDB.Close呜呜，就是行不通，而且是有时候发生问题，有时候没问题，真奇怪？！

Answer 4

在关闭表之前加上下面的程序：    With myTB 
        Set objIndex = .CreateIndex("IndexName")
        objIndex.Fields.Append objIndex.CreateField("UserID")
        objIndex.Primary = True
        .Indexes.Append objIndex
    End With

Answer 5

NetMan1999，这段代码是什么意思，创建索引、主健？为什么要添加它？能不能解释一下，另外把它添加到哪里？我试着添加了一下不行呀(可能位置不对）

Answer 6

您的程序：    Dim myTB As TableDef
    Set myTB = myDB.TableDefs(0)                     '打开表
    Dim myFd As Field
    Set myFd = myTB.CreateField("热量", dbSingle, 2) '添加字段
    myTB.Fields.Append myFd     ……依次类推，加入所有的字段
然后假如下面代码：
    
    Dim objIndex As Index    With myTB 
        Set objIndex = .CreateIndex("IndexName")
        objIndex.Fields.Append objIndex.CreateField("UserID")<---一般指定你表中的主建；
        objIndex.Primary = True
        .Indexes.Append objIndex
    End With

Answer 7

你可以先用新建表试试，就是新创建一个表mytb，然后加入字段

Answer 8

可是我的程序运行到添加字段时已经出错了，重新建一个一样的表就好了，而且运行十几次后又不行了，问了一个同学，他说可能是因为我用的access库不稳定，字段添来删去的出的错误。可是这个错误到底处在那了？可以解决吗？

Answer 9

下面是新建表的程序，你可以试试在前面采用传统的DAO连接数据库，获得objDatabase等对象，你仔细看看
'生成新的数据库表
'====================
Public Function CreateNewTable(ByVal strTableName As String, _
                               ByVal strErrorID As String, _
                               ByRef strError As String) As BooleanOn Error GoTo CreateTableError:    Dim i As Integer
    Dim strTemp As String
    Dim objTable As TableDef
    Dim objField As Field
    
    '1.删除需要建立的指定表
    '----------------------
    If DropTable(Trim(strTableName), strErrorID, strError) = False Then
        CreateNewTable = False
        Exit Function
    End If
    
    '2.建立新表
    '----------
    Set objTable = objDataBase.CreateTableDef(Trim(strTableName))
    
    With objTable
        
        '创建用户工资号字段
        '------------------
        Set objField = .CreateField("UserID", dbText, 10)
        objField.DefaultValue = "000001"
        objField.Required = True
        .Fields.Append objField
        
        '创建用户姓名字段
        '----------------
        Set objField = .CreateField("UserName", dbText, 10)
        objField.DefaultValue = "职工"
        objField.Required = True
        .Fields.Append objField        '备注字段
        '--------
        Set objField = .CreateField("Re", dbText, 254)
        objField.DefaultValue = "备注："
        objField.Required = False
        .Fields.Append objField    End With
    
    objDataBase.TableDefs.Append objTable
    
On Error GoTo CreateIndexError:
    
    Dim objIndex As Index
    
    With objTable
        Set objIndex = .CreateIndex("IndexName")
        objIndex.Fields.Append objIndex.CreateField("UserID")
        objIndex.Primary = True
        .Indexes.Append objIndex
    End With
    
    Set objTable = Nothing
    Set objField = Nothing
    Set objIndex = Nothing
    
    CreateNewTable = True
    Exit Function
    
CreateTableError:    strError = "创建表 <" + Trim(strTableName) + "> 失败，请稍候重试！" + _
               "(错误代码：" + Trim(strErrorID) + ")"
    
    Set objTable = Nothing
    Set objField = Nothing
    
    CreateNewTable = False
    Exit FunctionCreateIndexError:    strError = "创建主键 <UserID> 失败，请稍候重试！" + "(错误代码：" + Trim(strErrorID) + ")"
    
    Set objTable = Nothing
    Set objField = Nothing
    Set objIndex = Nothing
    
    CreateNewTable = FalseEnd Function
'从指定的数据库中删除指定的表
'============================
Public Function DropTable(ByVal strTableName As String, _
                          ByVal strErrorID As String, _
                          ByRef strError As String) As BooleanOn Error GoTo DropError:    If TableIsExist(Trim(strTableName), strErrorID, strError) = False Then
        If strError <> "" Then
            DropTable = False
        Else
            DropTable = True
        End If
        Exit Function
    End If    Call objDataBase.TableDefs.Delete(Trim(strTableName))
    
    DropTable = True
    Exit FunctionDropError:    strError = "删除指定的表 <" + Trim(strTableName) + "> 失败！请稍候重试！" + _
               "(错误代码：" + Trim(strErrorID) + ")"
    DropTable = FalseEnd Function
'判断指定的表名称在已经打开的数据库中是否存在
'============================================Public Function TableIsExist(ByVal strTableName As String, _
                             ByVal strErrorID As String, _
                             ByRef strError As String) As BooleanOn Error GoTo QueryError:
    
    Dim objTable As TableDef
    
    For Each objTable In objDataBase.TableDefs
        
        If UCase(Trim(objTable.Name)) = UCase(Trim(strTableName)) Then
            TableIsExist = True
            Set objTable = Nothing
            strError = ""
            Exit Function
        End If
  
    Next
    strError = ""
    TableIsExist = False
    Set objTable = Nothing
    Exit Function
    
QueryError:    strError = "对数据库的操作失败，请稍候再重试！(错误代码：" + strErrorID + ")"
    TableIsExist = False
    Set objTable = NothingEnd Function

Answer 10

换一种方法吧
不仅可以添加,还可删除,修改字段及其字段属性'先引用 Microsoft ActiveX Data Objects 2.x Library
   Dim ADO_Rset As New ADODB.Recordset
   Dim AdoStr As String
   '如果你的数据库不是 2000或以上的.那么Microsoft.Jet.OLEDB应该是3.0
   AdoStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\test.mdb;Persist Se
curity Info=False"
   With ADO_Rset
      .ActiveConnection = AdoStr
      .CursorLocation = adUseClient
      .CursorType = adOpenStatic
      .LockType = adLockBatchOptimistic
      '修改"姓名"字段
      .Source = "ALTER TABLE 学生 ALTER COLUMN 姓名 text(30)"
      .Open
      '增加"性别"字段
      .Source = "ALTER TABLE 学生 ADD 性别 text(20)"
      .Open
      '删除"籍贯"字段
      .Source = "ALTER TABLE 学生 DROP COLUMN 籍贯"
      .Open
   End With
   Set ADO_Rset = Nothing
至于各种数据类型是怎样表示的,请看下表Microsoft Access data type     OLE DB type indicator 
BINARY (< 255 bytes)           DBTYPE_BYTES 
BIT                             DBTYPE_BOOL 
BYTE                           DBTYPE_UI1 
COUNTER                       DBTYPE_I4 
CURRENCY                      DBTYPE_CY 
DATETIME                       DBTYPE_DATE 
DOUBLE                         DBTYPE_R8 
GUID                            DBTYPE_GUID 
LONG                             DBTYPE_I4 
LONGBINARY                       DBTYPE_BYTES 
LONGTEXT                         DBTYPE_STR 
SHORT                         DBTYPE_I2 
SINGLE                         DBTYPE_R4 
TEXT (< 255 bytes)             DBTYPE_STR