Phương thức Create Tabledef Trong access vba

Option Compare Database

Sub TaoChiTietHD()

On Error GoTo loi

Dim db As DAO.Database

Set db = CurrentDb()

Dim tbl As DAO.TableDef

Dim index As DAO.index

Set tbl = db.CreateTableDef("ChiTietHD")

tbl.Fields.Append tbl.CreateField("MaHD", dbText, 6)

tbl.Fields.Append tbl.CreateField("MaHang", dbText, 10)

tbl.Fields.Append tbl.CreateField("SLB", dbSingle)

'Cho phép de trong du lieu

tbl.Fields("MaHD").AllowZeroLength = True

tbl.Fields("MaHang").AllowZeroLength = True

'tbl.Fields("SLB").AllowZeroLength = True

'Giá tri mac dinh neu nhu không có du lieu

tbl.Fields("MaHD").DefaultValue = "None"

'Tao mot index cho bang Tbl

Set index = tbl.CreateIndex("MaHD")

Set index = tbl.CreateIndex("MaHang")

'Tao chi muc cho 2 field mac dinh

index.Fields.Append index.CreateField("MaHD")

index.Fields.Append index.CreateField("MaHang")

'Và deu là khoá chính cua bang

index.Primary = True

'Cung nhu su duy nhat

index.Unique = True

tbl.Indexes.Append index

'Them bang vao csdl

db.TableDefs.Append tbl

MsgBox "Ban Da tao Table" + tbl.Name

loi:

If Err.Number = 3010 Then

MsgBox "Da ton tai bang co ten" + tbl.Name

End If

End Sub

Read more »

Tạo đối tượng Relation Trong access vba

Private Sub cmdkhvapt_Click()

On Error GoTo loi

Dim db As DAO.Database

Dim rls As DAO.Relation

Set db = CurrentDb

Set rls = db.CreateRelation("TaoQuanHe9", "KhachHang", "PhieuThu", dbRelationUpdateCascade)

rls.Fields.Append rls.CreateField("MaKH")

rls.Fields("MaKH").ForeignName = "MaKH"

db.Relations.Append rls

loi:

If Err.Number = 3012 Then

MsgBox "Da ton tai quan he nay!"

End If

End Sub

Read more »

Tạo Form Đăng Ký Trong access vba

Private Sub buttoin_Click()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Set db = CurrentDb

Set rs = db.OpenRecordset("acount")

Dim dem As Integer

dem = 0

Do While rs.EOF = False

If rs!user = txtuser.Value Then

dem = 1

Exit Do

Exit Do

End If

rs.MoveNext

Loop

If dem = 1 Then

MsgBox "Ten nay da ton tai"

Exit Sub

End If

rs.AddNew

rs.Fields("user") = txtuser.Value

rs.Fields("pass") = txtpass.Value

rs.Fields("Ten") = txtten.Value

rs.Fields("Ho") = txtho.Value

rs.Fields("Email") = txtemail.Value

rs.Fields("SoDT") = txtsdt.Value

On Error Resume Next

rs.Update

MsgBox "Ban Da Dang Ky Thanh Cong", vbOKOnly, "Thong Bao!"

DoCmd.Close

End Sub

Read more »

Tạo Form đăng nhập Trong access vba

Private Sub txtdn_Click()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Set db = CurrentDb()

Dim user, pass As String

user = Trim(txtuser.Value)

On Error Resume Next

pass = Trim(txtpass.Value)

Set rs = db.OpenRecordset("acount")

Dim tam As Integer

tam = 0

Do While rs.EOF = False

If rs!user = user And rs!pass = pass Then

    labela.Caption = "ban da dang nhap thanh cong"

    If MsgBox("Ok de vao thang chuong trinh", vbOKOnly + vbQuestion, "Thong bao!") = vbOK Then

    DoCmd.OpenForm "F_Khoi_Tao"

    DoCmd.Close acForm, "DANG_NHAP"

    End If

    tam = 1

    Exit Do

Else

    tam = 0

End If

    rs.MoveNext

Loop

If tam = 0 Then

    If dem <= 3 Then

        'MsgBox "Ban dang nhap sai Password hay Username", vbOKOnly + vbQuestion, "Thong bao!"

        labela.Caption = "Ban dang nhap sai Password hay Username"

        dem = dem + 1

        txtuser.Value = " "

        txtpass.Value = " "

        txtuser.SetFocus

    Else

        If MsgBox("Ban da dang nhap qua 3 lan", vbYesNo + vbQuestion, "Thong bao!") = vbOK Then

            DoCmd.Quit acQuitPrompt

        Else

        labela.Caption = "Ban da bi khoa chuong trinh"

        End If

        

    End If

End If

End Sub

Read more »

Thêm xóa Sửa Trong access vba

Private Sub cmdthem_Click()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Set db = CurrentDb

Set rs = db.OpenRecordset("HoaDon")

Dim dem As Integer

dem = 0

Do While rs.EOF = False

If rs!MaHD = txtmahd.Value Then

dem = 1

Exit Do

End If

rs.MoveNext

Loop

If dem = 1 Then

MsgBox "Ma nay da ton tai", vbOKOnly, "Thong bao!"

Exit Sub

Else

rs.AddNew

rs!MaHD = txtmahd.Value

rs!NgayLHD = txtnlhd.Value

rs!MaKH = txtmakh.Value

rs!MaNV = txtmanv.Value

On Error Resume Next

rs.Update

MsgBox "Ban da luu du lieu thanh cong"

txtmahd.Value = Delete

txtnlhd.Value = Delete

txtmakh.Value = Delete

txtmanv.Value = Delete

End If

End Sub

Private Sub cmdsua_Click()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Set db = CurrentDb

Set rs = db.OpenRecordset("HoaDon")

Do While rs.EOF = False

If rs!MaHD = txtmahd.Value Then

rs.Edit

rs!MaHD = txtmahd.Value

rs!NgayLHD = txtnlhd.Value

rs!MaKH = txtmakh.Value

rs!MaNV = txtmanv.Value

rs.Update

MsgBox "Ban da suu du lieu thanh cong", vbOKOnly, "Thong bao!"

txtmahd.Value = Delete

txtnlhd.Value = Delete

txtmakh.Value = Delete

txtmanv.Value = Delete

Exit Do

End If

rs.MoveNext

Loop

rs.Close

End Sub

Private Sub cmdtim_Click()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Set db = CurrentDb

Set rs = db.OpenRecordset("HoaDon")

Do While rs.EOF = False

If rs!MaHD = txttim.Value Then

MsgBox "Ma hoa don " & " " & txttim & " " & "da duoc tim thay"

txtmahd.Value = rs.Fields("MaHD").Value

txtnlhd.Value = rs.Fields("NgayLHD").Value

txtmakh.Value = rs.Fields("MaKH").Value

txtmanv.Value = rs.Fields("MaNV").Value

Exit Do

End If

rs.MoveNext

Loop

End Sub

Private Sub cmdxoa_Click()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Set db = CurrentDb

Set rs = db.OpenRecordset("HoaDon")

Do While rs.EOF = False

If rs!MaHD = txtmahd.Value Then

If MsgBox("Ban muon xoa du lieu", vbOKCancel, "Thong bao!") = vbOK Then

rs.Delete

MsgBox "Ban da xoa du lieu thanh cong", vbOKOnly, "Thong bao!"

txtmahd.Value = Delete

End If

Exit Do

End If

rs.MoveNext

Loop

End Sub

Read more »