- Код: Выделить всё
dbTarget.Tabledefs.Append tdNew
вызывает ошибку - "3001: ошибочный аргумент". Не могу понять в чем дело. Полный код ниже. Чтоб было понятнее - это институтское упражнение, надо скопировать таблицу со структурой и содержимым.
Буду признателен.
- Код: Выделить всё
Private Sub Command1_Click()
Dim db As Database
Dim td As TableDef
Dim rsSrc As Recordset, rsTarget As Recordset
GoTo 11
If Dir$("c:\qq.mdb") <> "" Then Kill "c:\qq.mdb"
Set db = CreateDatabase("c:\qq.mdb", dbLangGeneral, dbVersion30)
Set td = db.CreateTableDef("tdExample")
td.Fields.Append td.CreateField("Code", dbLong)
td.Fields.Append td.CreateField("Name", dbText, 250)
td.Fields.Append td.CreateField("Surname", dbText, 250)
db.TableDefs.Append td
CreateTableDefCopy db, td, "New2"
11:
Set db = OpenDatabase("c:\qq2.mdb", False, False)
Set td = db.TableDefs("Table1")
CreateTableDefCopy db, td, "New2"
Set rsSrc = db.OpenRecordset("Table1", dbOpenTable, , dbOptimistic)
Set rsTarget = db.OpenRecordset("New", dbOpenTable, , dbOptimistic)
CopyTableContent rsSrc, rsTarget
db.Close
Set db = Nothing
End Sub
Public Function CreateFieldCopy(ByRef tdOwner As Variant, ByRef fSrc As Field) As Field
'tdOwner - предполагается TableDef или Index
Dim fNew As Field
Set fNew = tdOwner.CreateField(fSrc.Name)
fNew.Attributes = fSrc.Attributes
tdOwner.Fields.Append fNew
Set CreateFieldCopy = fNew
End Function
Public Function CreateIndexCopy(ByRef tdTarget As TableDef, ByRef indSrc As Index) As Index
Dim indNew As Index
Dim fSrc As Field
Set indNew = tdTarget.CreateIndex(indSrc.Name)
For Each fSrc In indSrc.Fields
CreateFieldCopy indNew, fSrc
Next
'заремлены свойства read-only
indNew.Clustered = indSrc.Clustered
'indNew.DistinctCount = indSrc.DistinctCount
' indNew.Foreign = indSrc.Foreign
indNew.IgnoreNulls = indSrc.IgnoreNulls
indNew.Primary = indSrc.Primary
'indNew.Properties = indSrc.Properties
indNew.Required = indSrc.Required
indNew.Unique = indSrc.Unique
tdTarget.Indexes.Append indNew
Set CreateIndexCopy = indNew
End Function
Public Function CreateTableDefCopy(ByRef dbTarget As Database, ByRef tdSrc As TableDef, ByRef sNewTDName As String) As TableDef
Dim tdNew As Object
Dim indSrc As Index, indNew As Index
Dim fSrc As Field, fNew As Field
Dim i As Long
Set tdNew = dbTarget.CreateTableDef(sNewTDName, tdSrc.Attributes)
For Each fSrc In tdSrc.Fields
CreateFieldCopy tdNew, fSrc
Next
For Each indSrc In tdSrc.Indexes
CreateIndexCopy tdNew, indSrc
Next
dbTarget.TableDefs.Append tdNew
Set CreateTableDefCopy = tdNew
End Function
Public Sub CopyTableContent(ByRef rsSrc As Recordset, ByRef rsTarget As Recordset)
Dim i As Long
rsSrc.MoveFirst
While Not (rsSrc.EOF)
rsTarget.AddNew
For i = 0 To rsSrc.Fields.Count - 1
rsTarget.Fields(i).Value = rsSrc.Fields(i).Value
Next i
rsTarget.Update
rsSrc.MoveNext
Wend
End Sub
