I. Thiết kế cơ sở dữ liệu trong Access
4.Cài đặt chương trình
Sau đây là một số thủ tục được thực hiện trong chương trình
•Thủ tục mở kết nối dữ liệu Sub Open_mdb()
Dim db_name, str As String
db_name = App.Path & "\Lien.mdb"
str = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & db_name & "" DE1.CN1.ConnectionString =
"Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & db_name & ""
cn.Open str
End Sub
•Hàm kiểm tra ngày tháng
Public Function Test_Day(ngay As String) As Boolean
Dim KTNgay As Integer
Dim so
so = CInt(Val(Trim(Right(ngay, 4)))) KTNgay = CInt(Val(Left(ngay, 2)))
If CInt(Val(Trim(Right(ngay, 4)))) < 1000 Then
MsgBox "Nam phai co 4 chu so.Vui long nhap lai.", vbOKOnly + vbExclamation, "Thong bao"
Test_Day = False Exit Function
End If
If CInt(Val(Trim(Mid(ngay, 4, 2)))) < 1 Or
CInt(Val(Trim(Mid(ngay, 4, 2)))) > 12 Then
MsgBox "Ngay thang khong hop le. Vui long nhap lai", vbOKOnly + vbExclamation, "Thong bao"
Test_Day = False
Else
Select Case CInt(Val(Trim(Mid(ngay, 4, 2)))) Case 1, 3, 5, 7, 8, 10, 12
MsgBox " Thang " & Mid(ngay, 4, 2) & " co 31 ngay", vbOKOnly + vbExclamation, "Thong bao"
Test_Day = False
Else
Test_Day = True
End If Case 2
If KTNgay < 1 Or KTNgay > 29 Then
MsgBox " ngay khong hop le", vbOKOnly + vbExclamation, "Thong bao" Test_Day = False (adsbygoogle = window.adsbygoogle || []).push({});
Else
If namnhuan(Right(ngay, 4)) = False Then
If KTNgay > 28 Then
MsgBox "Nam " & Right(ngay, 4) & " thang 2 co 28 ngay. Vui long nhap lai", vbOKOnly + vbExclamation, "Thong bao"
Test_Day = False End If Else Test_Day = True End If End If Case Else
If KTNgay < 1 Or KTNgay > 30 Then
" chi co 30 ngay. Vui long nhap lai.", vbOKOnly + vbExclamation, "Thong bao" Test_Day = False Else Test_Day = True End If End Select End If End Function • Thủ tục đăng ký thuê phòng
Input : THÔNG TIN ĐĂNG KÝ THUÊ PHÒNG
Output : Thông tin đăng ký thuê phòng ghi vào bảng DANGKY Xử lý:
Private Sub Luu_Du_Lieu()
Dim rs As New ADODB.Recordset Dim rs1 As New ADODB.Recordset Dim str
If Trim(txtSoDK) = "" Or Trim(txtMaKH) = "" Or Trim(txtMaP) = "" Then
MsgBox "Chu y: MaKH, SoDK, MaP khong duoc trong", vbOKOnly + vbExclamation, "Thong bao"
Me.MousePointer = 0 Exit Sub
End If
str = "select*from PHONG where MaP='" & Trim(txtMaP) & "'" rs1.Open str, cn, adOpenKeyset, adLockOptimistic, adCmdText
If txtMaP = rs1!MaP Then
rs1.Update rs1.Close
str = "select*from Dangky where SoDK='" & Trim(txtSoDK) & "' " rs.Open str, cn, adOpenKeyset, adLockOptimistic, adCmdText If rs.EOF = True Then
rs.AddNew rs!MaKH = txtMaKH rs!soDK = txtSoDK rs!NgayDK = txtNgayDK rs!MaP = txtMaP rs!Ngayden = txtNgayden rs!Gioden = txtGioden rs!Ngaydi = txtNgaydi rs!Giodi = txtGiodi rs!SLNL = txtSLNL rs!SLTE= txtSLTE rs!Giathue = txtGiathue rs!Tiencoc = txtTiencoc rs.Update rs.Close Else
Dim kiemtra
If txtSoDK = rs! SoDK Then
kiemtra = MsgBox(" Khach hang co So dang ky [" & txtSoDK & "]da ton tai. Neu ban muon SUA thong tin khach hang thi bam Yes", vbYesNo + vbQuestion, "Thong bao")
If kiemtra = vbNo Then Exit Sub Else rs!MaKH = txtMaKH rs!SoDK = txtSoDK rs!NgayDK = txtNgayDK rs!MaP = txtMaP rs!Ngayden = txtNgayden rs!Gioden = txtGioden rs!Ngaydi = txtNgaydi rs!Giodi = txtGiodi rs!SLNL = txtSLNL rs!SLTE = txtSLTE rs!Giathue = txtGiathue rs!Tiencoc = txtTiencoc rs.Update End If End If End If End If
Lock_Text
Display_Listview cmdNEW.SetFocus Me.MousePointer = 0
End Sub
• Hàm kiểm tra ngày đến
Private Function KTNgayden(Ngayden As String) As Boolean
Dim rs As New ADODB.Recordset (adsbygoogle = window.adsbygoogle || []).push({});
Dim str
str = " select * from Dangky where SoDK='" & Trim(txtSoDK.Text) & "'" rs.Open str, cn, adOpenKeyset, adLockOptimistic, adCmdText
If rs.EOF = True Then
If txtNgayDK = "" Then
MsgBox " Ban chua nhap ngay dang ky ! ", vbOKOnly + vbExclamation, "Thong bao"
KTNgayden = False txtNgayDK.SetFocus
Exit Function Else
If CDate(Ngaythang(Ngayden)) < txtNgayDK Then
MsgBox " Ngayden phai >= [" & txtNgayDK & "] ", vbOKOnly + vbExclamation, "Thong bao"
KTNgayden = False
Else
End If End If Else
If CDate(Ngaythang(Ngayden)) < rs!NgayDK Then
MsgBox " Ngayden phai >= [" & txtNgayDK & "] ", vbOKOnly + vbExclamation, "Thong bao"
KTNgayden = False Else KTNgayden = True End If End If End Function