房屋租赁管理系统源代码.docx

系统主界面的设计
启动系统后，主界面设计效果图如下:

公用模块的设计代码分析如下:
Option Explicit
Public conn As New ADODB.Connection
'定义全局变量queryhouse 作为判断frmHouse 窗体显示查询的数据还是全体数据
Public queryhouse As Boolean
'定义全局变量sqlqh 作为查询房屋信息时的sql语句
Public sqlqh As String
'定义全局变量querycf 作为判断frmClient 窗体家庭租户选项卡显示查询的数据还是全体数据
Public querycf As Boolean
'定义全局变量sqlqcf 作为查询家庭租户信息时的sql语句
Public sqlqcf As String
'定义全局变量querycg 作为判断frmClient 窗体家公司户选项卡显示查询的数据还是全体数据
Public querycg As Boolean
'定义全局变量sqlqcg 作为查询公司租户信息时的sql语句
Public sqlqcg As String
'定义全局变量queryemp 作为判断frmEmp 窗体显示查询的数据还是全体数据
Public queryemp As Boolean
'定义全局变量sqlqe 作为查询员工信息时的sql语句
Public sqlqe As String
'定义全局变量queryqzc 作为判断frmQZClient 窗体显示查询的数据还是全体数据
Public queryqzc As Boolean
'定义全局变量sqlqzc 作为查询求租客户信息时的sql语句
Public sqlqzc As String
'定义全局变量querycon 作为判断frmAdminContract 窗体显示查询的数据还是全体数据
Public querycon As Boolean
'定义全局变量sqlqcon 作为查询合同信息时的sql语句
Public sqlqcon As String
'定义全局变量sqlqyd 作为查询预定单信息时的sql语句
Public sqlqyd As String
'定义全局变量fromqzc 作为判断frmYuDing 窗体是从frmQZClient窗体中单击下定金预定调用的
'还是直接菜单调用的
Public fromqzc As Boolean
'定义全局变量fromYuding 作为判断frmPayDingJin 窗体是从frmYuDing窗体中单击收取定金调用的
'还是直接菜单调用的
Public fromYuding As Boolean
'定义全局变量fromContract 作为判断frmPayYaJin 窗体是从frmSignContract窗体中单击收取押金调用的
'还是直接菜单调用的
Public fromContract As Boolean
'定义全局变量ZuJinfromContract 作为判断frmPayZuJin 窗体是从frmSignContract窗体中单击收取租金调用的
'还是直接菜单调用的
Public ZuJinfromContract As Boolean
'定义全局变量queryZuJin 作为判断frmAdminZuJin 窗体显示查询的数据还是全体数据
Public queryZuJin As Boolean
'定义全局变量sqlqzj 作为查询合同信息时的sql语句
Public sqlqzj As String
'定义全局变量sqlqdj 作为查询定金信息时的sql语句
Public sqlqdj As String
'定义全局变量sqlqyj 作为查询押金信息时的sql语句
Public sqlqyj As String
1.各主要功能模块的设计与实现
1．1基本资料管理模块设计
房屋基本资料管理的运行效果图如下:

其表单界面的属性设计比较直观,在此重点分析新增,修改,删除,保存四个命令按钮的源代码设计：
新增按钮源码:
Private Sub cmdAdd_Click()
'设置除保存和取消按钮外的其他按钮不可用
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDel.Enabled = False
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdFirst.Enabled = False
cmdPrev.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
cmdQuery.Enabled = False
'需要清空所有text框，并且设置它们可写
For i = 0 To 7
Text1(i).Text = ""
Text1(i).Enabled = True
Next i
Combo1.Enabled = True
'add变量用于保存时判断是从添加还是修改后保存
add = 1
Text1(0).SetFocus
End Sub
Private Sub cmdCancel_Click()
'取消按钮用于用户添加或修改过程中放弃添加或修改操作
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdAdd.Enabled = True
cmdQuery.Enabled = True
'如果是从添加后取消
If add = 1 Then
'如果当前House表中有数据则显示第一条数据
If Not rs_house.EOF And Not rs_house.BOF Then
For i = 0 To 7
Text1(i).Text = rs_house.Fields(i)
Next i
If rs_house.Fields(8) = "已租" Then
Combo1.ListIndex = 0
ElseIf rs_house.Fields(8) = "未租" Then
Combo1.ListIndex = 1
ElseIf rs_house.Fields(8) = "意向" Then
Combo1.ListIndex = 2
End If
cmdEdit.Enabled = True
cmdDel.Enabled = True
cmdFirst.Enabled = True
cmdPrev.Enabled = True
cmdNext.Enabled = True
cmdLast.Enabled = True
'如果没有数据，则显示空
Else
For i = 0 To 7
Text1(i).Text = ""
Next i
cmdEdit.Enabled = False
cmdDel.Enabled = False
cmdFirst.Enabled = False
cmdPrev.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
End If
'如果是修改后取消，则恢复到修改前的数据
ElseIf add = 0 Then
For i = 0 To 7
Text1(i).Text = rs_house.Fields(i)
Next i
If rs_house.Fields(8) = "已租" Then
Combo1.ListIndex = 0
ElseIf rs_house.Fields(8) = "未租" Then
Combo1.ListIndex = 1
ElseIf rs_house.Fields(8) = "意向" Then
Combo1.ListIndex = 2
End If
End If
'开始时设置各个text框不可写
For i = 0 To 7
Text1(i).Enabled = False
Next i
'先设置ComboBox的默认值及不可改
Combo1.Enabled = False
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
删除按钮的源代码：
Private Sub cmdDel_Click()
'当单击删除记录时，需要弹出一个提示框，警告用户
Dim answer As String
answer = MsgBox("确定要删除吗？", vbYesNo, "")
'确实删除
If answer = vbYes Then
rs_house.Delete '删除当前记录
rs_house.Update '更新删除
MsgBox "成功删除！", vbOKOnly + vbExclamation, ""
Else
Exit Sub
End If
'删除之后，显示总信息条数需要减 1
Text2.Text = Val(Text2.Text) - 1
'删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录
'先移动rs_house记录到后一条
rs_house.MoveNext
If rs_house.EOF Then
rs_house.MovePrevious
'如果没有到记录首则显示该记录
If Not rs_house.BOF Then
For i = 0 To 7
Text1(i).Text = rs_house.Fields(i)
Next i
If rs_house.Fields(8) = "已租" Then
Combo1.ListIndex = 0
ElseIf rs_house.Fields(8) = "未租" Then
Combo1.ListIndex = 1
ElseIf rs_house.Fields(8) = "意向" Then
Combo1.ListIndex = 2
End If
'如果到记录首，则表格已经为空，置所有text框显示为空
ElseIf rs_house.BOF Then
For i = 0 To 7
Text1(i).Text = ""
Next i
cmdFirst.Enabled = False
cmdPrev.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
End If
'如果删除的不是首尾记录，则显示当前记录即可
Else
For i = 0 To 7
Text1(i).Text = rs_house.Fields(i)
Next i
If rs_house.Fields(8) = "已租" Then
Combo1.ListIndex = 0
ElseIf rs_house.Fields(8) = "未租" Then
Combo1.ListIndex = 1
ElseIf rs_house.Fields(8) = "意向" Then
Combo1.ListIndex = 2
End If
End If
End Sub
保存按钮的源代码：
Private Sub cmdEdit_Click()
'设置除保存和取消按钮外的其他按钮不可用
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDel.Enabled = False
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdFirst.Enabled = False
cmdPrev.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
cmdQuery.Enabled = False
'需要设置除主键之外的text框可写
For i = 1 To 7
Text1(i).Enabled = True
Next i
Combo1.Enabled = True
add = 0
End Sub
Private Sub cmdFirst_Click()
'先移动rs_house记录到第一条
rs_house.MoveFirst
'同时需要设置相应按钮为不可用和不可用
cmdPrev.Enabled = False
cmdFirst.Enabled = False
cmdNext.Enabled = True
cmdLast.Enabled = True
'如果已经是第一条记录，则提示用户
If rs_house.BOF = True Then
MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
Exit Sub
'如果不是，则个数据表的记录位置移到第一条记录，并且显示之
Else
For i = 0 To 7
Text1(i).Text = rs_house.Fields(i)
Next i
If rs_house.Fields(8) = "已租" Then
Combo1.ListIndex = 0
ElseIf rs_house.Fields(8) = "未租" Then
Combo1.ListIndex = 1
ElseIf rs_house.Fields(8) = "意向" Then
Combo1.ListIndex = 2
End If
End If
End SubPREV
检索按钮的源代码：
1．2 客户资料管理模块的设计
1．2．1租户基本资料的设计
运行效果图如下所示:

在租户基本资料中，我们重点分析查找家庭租户功能的源码，如下:
Private Sub cmdQuery_Click()
If Text1.Text = "" Then
MsgBox "查询条件不可为空！", vbOKOnly + vbInformation, "注意"
Text1.SetFocus
Exit Sub
End If
'设置查询家庭租户变量为真
querycf = True
sqlqcf = " where " & Combo1.Text & " = " & "'" & Text1.Text & "'"
frmClient.Show
'关闭本窗体
Unload Me
End Sub
1．2．2求租户基本资料的设计

其保存按钮的源码分析如下：
Private Sub cmdSave_Click()
'检测数据是否完整
If Text1(0).Text = "" Then
MsgBox "求租客户编号不可为空！", vbOKOnly + vbInformation, "注意"
Text1(0).SetFocus
Exit Sub
ElseIf Text1(1).Text = "" Then
MsgBox "求租客户姓名不可为空！", vbOKOnly + vbInformation, "注意"
Text1(1).SetFocus
Exit Sub
ElseIf Text1(2).Text = "" Then
MsgBox "求租客户电话不可为空！", vbOKOnly + vbInformation, "注意"
Text1(2).SetFocus
Exit Sub
ElseIf Not Text1(4).Text = "" And IsNumeric(Text1(4).Text) = False Then
MsgBox "面积要求不为空则应为数字！", vbOKOnly + vbInformation, "注意"
Text1(4).SetFocus
Exit Sub
ElseIf Not Text1(6).Text = "" And IsNumeric(Text1(6).Text) = False Then
MsgBox "意向价位不为空则应为数字！", vbOKOnly + vbInformation, "注意"
Text1(6).SetFocus
Exit Sub
ElseIf Not Text1(7).Text = "" And IsNumeric(Text1(7).Text) = False Then
MsgBox "意向租期不为空则应为数字！", vbOKOnly + vbInformation, "注意"
Text1(7).SetFocus
Exit Sub
End If
'如果意向房屋编号不为空，需要检查是否存在
If Not Text1(8).Text = "" Then
Dim sqlhcheck As String
Dim rs_hcheck As New ADODB.Recordset
sqlhcheck = "select * from House where 房屋编号 = '" & Text1(8).Text & "'"
rs_hcheck.Open sqlhcheck, conn, adOpenStatic, adLockOptimistic
If rs_hcheck.EOF Then
MsgBox "该房屋编号不存在，请重填或清空！", vbOKOnly + vbInformation, "注意"
Text1(8).SetFocus
rs_hcheck.Close
Exit Sub
End If
rs_hcheck.Close
End If
'添加数据后保存
If add = 1 Then
'检测房屋编号这个主键是否已经在表中存在
Dim rs_check As New ADODB.Recordset
Dim sqlCheck As String
sqlCheck = "select * from QZClient where 求租客户编号= '" & (Text1(0).Text) & "'"
rs_check.Open sqlCheck, conn, adOpenStatic, adLockOptimistic
If Not rs_check.EOF And Not rs_check.BOF Then
MsgBox "该求租客户编号已经存在，请重填一个！", vbOKOnly + vbInformation, "注意"
rs_check.Close
Text1(0).SetFocus
Text1(0).Text = ""
Exit Sub
End If
rs_check.Close
'主键不重复，可以加入表中
rs_QZClient.AddNew
For i = 0 To 9
rs_QZClient.Fields(i) = Text1(i).Text
Next i
rs_QZClient.Update
'添加之后显示总共条数信息加 1
Text2.Text = Val(Text2.Text) + 1
'修改数据后的保存
Else
rs_QZClient.Update
End If
MsgBox "保存数据成功！", vbOKOnly + vbInformation, "祝贺"
'保存后需要设置其他按钮可用，以及各个text框不可写
cmdAdd.Enabled = True
cmdEdit.Enabled = True
cmdDel.Enabled = True
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdFirst.Enabled = True
cmdPrev.Enabled = True
cmdNext.Enabled = True
cmdLast.Enabled = True
cmdQuery.Enabled = True
cmdYuDing.Enabled = True
For i = 0 To 9
Text1(i).Enabled = False
Next i
End Sub
1．3 租赁管理模块的设计
1．3 .1签订合同的设计
因租赁管理，财务管理和统计报表三个模块的窗体设计比较多，无法一一描述，故选择有代表性的窗体设计加以分析，其合同签订窗体的运行效果图如下:

如图所示,签订的源码设计如下:
Private Sub cmdSign_Click()
'先检查输入数据完整性
For i = 0 To 2
If Text1(i).Text = "" Then
MsgBox "除备注外的所有项不可为空！", vbOKOnly + vbInformation, "注意"
Text1(i).SetFocus
Exit Sub
End If
Next i
For i = 3 To 4
If Text1(i).Text = "" Or IsDate(Text1(i).Text) = False Then
MsgBox "日期应为这样的格式：2003-7-15！", vbOKOnly + vbInformation, "注意"
Text1(i).SetFocus
Exit Sub
End If
Next i
If Text1(6).Text = "" Or IsNumeric(Text1(6).Text) = False Then
MsgBox "月租金应为数字！", vbOKOnly + vbInformation, "注意"
Text1(6).SetFocus
Exit Sub
End If
If Text1(8).Text = "" Or IsNumeric(Text1(8).Text) = False Then
MsgBox "押金应为数字！", vbOKOnly + vbInformation, "注意"
Text1(8).SetFocus
Exit Sub
End If
If Text1(9).Text = "" Then
MsgBox "业务员不可为空！", vbOKOnly + vbInformation, "注意"
Text1(9).SetFocus
Exit Sub
End If
If Text1(10).Text = "" Or IsDate(Text1(10).Text) = False Then
MsgBox "签订日期应为这样的格式：2003-7-15！", vbOKOnly + vbInformation, "注意"
Text1(10).SetFocus
Exit Sub
End If
'止租日期不能前于起租日期
If DateValue(Text1(4).Text) < DateValue(Text1(3).Text) Then
MsgBox "止租日期不能前于起租日期", vbOKOnly + vbInformation, "注意"
Text1(4).SetFocus
Exit Sub
End If

'租期等于起租日期和止租日期之差，结尾不足一月，按一月计。
'使用datediff 函数计算日期之差
Text1(5).Text = Int(DateDiff("d", DateValue(Text1(3).Text), DateValue(Text1(4).Text)) / 31) + 1
'总租金等于月租金乘以租期
Text1(7).Text = Val(Text1(5).Text) * Val(Text1(6).Text)
'检查完数据完整性后，还需要检查该客户是否已存入租户表中，以及该房屋是否为未出租或预定状态
sqlc = "select * from Client where 租户姓名 = '" & Text1(1).Text & "'"
rs_ccheck.Open sqlc, conn, adOpenStatic, adLockOptimistic
If rs_ccheck.EOF = True Then
rs_ccheck.Close
MsgBox "该客户资料还未存入租户资料表中，请先录入该客户资料！", vbOKOnly + vbInformation, "注意"
Exit Sub
End If
rs_ccheck.Close
'检测房屋状态
sqlh = "select * from House where 房屋编号 = '" & Text1(2).Text & "'"
rs_hcheck.Open sqlh, conn, adOpenStatic, adLockOptimistic
If rs_hcheck.EOF = True Then
MsgBox "该房屋编号不存在，请重新输入一个！", vbOKOnly + vbInformation, "注意"
Text1(2).SetFocus
rs_hcheck.Close
Exit Sub
ElseIf rs_hcheck.Fields(8) = "已租" Then
MsgBox "该房屋已经出租了，请选择另一房屋！", vbOKOnly + vbInformation, "注意"
rs_hcheck.Close
Exit Sub
'如果该房屋状态为预定，则需要看预定人是否为该客户，如果不是，需要弹出对话框提示用户
ElseIf rs_hcheck.Fields(8) = "预定" Then
'检查该客户是否为预定客户
sqlyd = "select * from YuDing where 预定房屋编号 = '" & Text1(2).Text & " '"
rs_yd.Open sqlyd, conn, adOpenStatic, adLockOptimistic
'如果该客户不是预定客户，检查预定有效期
If Not rs_yd.Fields(1) = Text1(1).Text Then
'如果已经过了预定有效期，别的用户可以承租
If (Date > DateAdd(d, rs_yd.Fields(4), rs_yd.Fields(8))) Then
'出租，加入合同表
sqlcon = "select * from Contract"
rs_contract.Open sqlcon, conn, adOpenStatic, adLockOptimistic
rs_contract.AddNew
For i = 0 To 11
rs_contract.Fields(i) = Text1(i).Text
Next i
rs_contract.Update
'修改房屋状态
rs_hcheck(8) = "已租"
rs_hcheck.Update
'检查求租客户表中是否有该客户，如果有，则删除之
sqlqzc = "select * from QZClient where 求租客户姓名 = '" & Text1(1).Text & "'"
rs_qzc.Open sqlqzc, conn, adOpenStatic, adLockOptimistic
If rs_qzc.EOF = False Then
rs_qzc.Delete
rs_qzc.Update
End If
'显示签订合同成功
MsgBox "签订合同成功！", vbOKOnly + vbInformation, "注意"
'设置签订按钮不可用
cmdSign.Enabled = False
cmdYaJin.Enabled = True
cmdZuJin.Enabled = True
'关闭所有打开的记录集
rs_qzc.Close
rs_yd.Close
rs_hcheck.Close
rs_contract.Close
Exit Sub
Else
MsgBox "该房屋已经被别人预定了，请选择另一房屋！", vbOKOnly + vbInformation, "注意"
rs_hcheck.Close
rs_yd.Close
Exit Sub
End If
'该客户即为预定客户，可以出租
ElseIf rs_yd.Fields(1) = Text1(1).Text Then
'出租，加入合同表
sqlcon = "select * from Contract"
rs_contract.Open sqlcon, conn, adOpenStatic, adLockOptimistic
rs_contract.AddNew
For i = 0 To 11
rs_contract.Fields(i) = Text1(i).Text
Next i
rs_contract.Update
'修改房屋状态
rs_hcheck(8) = "已租"
rs_hcheck.Update
'删除预定表中该项
rs_yd.Delete
rs_yd.Update
'检查求租客户表中是否有该客户，如果有，则删除之
sqlqzc = "select * from QZClient where 求租客户姓名 = '" & Text1(1).Text & "'"
rs_qzc.Open sqlqzc, conn, adOpenStatic, adLockOptimistic
If rs_qzc.EOF =