Lam the nao de xac dinh mot field la key !

[tuanlotus]

Toi dung VB ket noi voi Access truy cap CSDL bang ADO nhung khong biet lam the nao de xac dinh mot fied la khoa.Cam on !!!

[paulsteigel]

Gửi bạn một đoạn mã này nhé.
Xin các bác Admin đừng bỏ đi từ khoá nào nhé, hôm trước tôi viết chữ ******0 nó bỏ mất các chữ và biến thành ****** chán phèo.
Xin lỗi bạn nhé, mình quên là đã comment tất cả bằng tiếng Anh nên không tiện lắm, bạn cần hỏi gì thì cứ viết nhé
(Mục đích của hàm hasindex này là xác định xem trường có chỉ số không, nếu đúng thế thì đó chính là Key, thông thường mình chỉ đặt index cho trường key mà thôi)

Function CreateTableString(iDbs As String)
‘ Hàm này lấy cấu trúc của bảng để lưu lại nhằm tạo lại bảng khi cần
Dim iSql As String, i As Long, idxFldName As String, iPrimaryString As String
Dim dbs As Database, iTdf As TableDef, rcs As Recordset

' for system progresbar
Dim varReturn As Variant

DoCmd.Hourglass True
' Display progress in the status bar area.

CurrentDb.Execute ("Delete * from [_TblDef];")
Set rcs = CurrentDb.OpenRecordset("_TblDef")
Set dbs = OpenDatabase(iDbs)
For Each iTdf In dbs.TableDefs
With iTdf
If Left(.Name, 2) <> "MS" And Left(.Name, 1) <> "_" Then
varReturn = SysCmd(acSysCmdInitMeter, "Creating table now..." & .Name & "...", 40)

If HasIndex(iTdf, idxFldName) Then
If idxFldName <> "" Then ' this is - a table without primary key
If Left(idxFldName, 1) = "+" Then idxFldName = Right(idxFldName, Len(idxFldName) - 1)
' now start to generate table string
iPrimaryString = ReturnAttribute(.Fields(idxFldName)) & " CONSTRAINT " & idxFldName & " PRIMARY KEY"
End If
End If
For i = 0 To .Fields.Count - 1
If .Fields(i).Name = idxFldName Then
iSql = iSql & iPrimaryString & ", "
Else
iSql = iSql & ReturnAttribute(.Fields(i)) & ", "
End If
varReturn = SysCmd(acSysCmdUpdateMeter, i + 10)
Next
idxFldName = ""
iPrimaryString = ""
If iSql <> "" Then iSql = Mid(iSql, 1, Len(iSql) - 2)
iSql = "CREATE TABLE [" & .Name & "](" & iSql & ");"
Debug.Print iSql
rcs.AddNew
rcs.Fields(1) = iSql
rcs.Update
Debug.Print iSql
iSql = ""
End If
End With
Next
varReturn = SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
ExitNow:
Set iTdf = Nothing
dbs.Close
End Function

Public Function ReturnAttribute(iTbField As Field)
Select Case iTbField.Type
Case 1:
ReturnAttribute = "YesNo"
Case 4:
If iTbField.Attributes = 17 Then
ReturnAttribute = "AutoIncrement"
Else
ReturnAttribute = "Integer"
End If
Case 3, 6:
ReturnAttribute = "Single"
Case 7:
ReturnAttribute = "Single"
Case 8:
ReturnAttribute = "DateTime"
Case 10:
ReturnAttribute = "Text(" & iTbField.Size & ")"
Case 11:
ReturnAttribute = "OLEObject"
Case 12:
ReturnAttribute = "Memo"
End Select
ReturnAttribute = "[" & iTbField.Name & "] " & ReturnAttribute
End Function

Function HasIndex(iTdf As TableDef, Optional mIndexField As String = "") As Boolean
‘ Hàm này kiểm tra bảng và trả về trường Key (khoá) nếu có
Dim idxNew As Index, iSql As String
On Error GoTo ErrHandler
If mIndexField <> "" Then
Set idxNew = iTdf.Indexes(mIndexField)
Else
For Each idxNew In iTdf.Indexes
If idxNew.Primary Then
mIndexField = idxNew.Fields
Exit For
End If
Next
End If
HasIndex = True
Exit Function
ErrHandler:
If Err <> 0 Then HasIndex = False
End Function