求助VB编程中的一代码

只满足一个条件的代码:
Option Explicit
Private Sub Command1_Click()
Dim tidcard As String
Dim jiguan As String
Dim cnn As New ADODB.Connection
Dim ret As New ADODB.Recordset
Dim local_db As String
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path & "\data\db.mdb" + ";Persist Security Info=False;"
tidcard = Trim(Text1.Text)
If Text1.Text = "" Then
MsgBox "请输入姓名", , "警告"
Text1.SetFocus
Else
Set ret = New ADODB.Recordset
local_db = "select * from 人口表" + _
" where 人口表.姓名=" + "'" + tidcard + "'"
ret.Open local_db, cnn
If ret.BOF And ret.EOF Then
MsgBox "无此身份证号，请重新输入"
Text1.Text = ""
Text1.SetFocus

Else
Dim d1 As String
frmpren.Label2.Caption = ret("户号")
frmpren.Label38.Caption = ret("姓名")
frmpren.Label3.Caption = ret("与户主关系")
frmpren.Label39.Caption = ret("身份证号")
frmpren.Label4.Caption = ret("性别")
frmpren.Label8.Caption = ret("民族")
frmpren.Label29.Caption = ret("籍贯")
d1 = ret("出生日期")
frmpren.Label30.Caption = Mid(d1, 1, 4)
frmpren.Label31.Caption = Mid(d1, 5, 2)
frmpren.Label36.Caption = Mid(d1, 7, 2)
frmpren.Label34.Caption = ret("出生地")
frmpren.Label41.Caption = ret("文化程度")
frmpren.Label6.Caption = ret("婚姻状况")
frmpren.Label40.Caption = ret("职业")
frmpren.Label43.Caption = ret("工作单位")
frmpren.Label23.Caption = ret("迁入日期")
frmpren.Label28.Caption = ret("何地迁入")
ret.Close
Set ret = New ADODB.Recordset
local_db = "select * from 人迁出表" + _
" where 人迁出表.身份证号=" + "'" + tidcard + "'"
ret.Open local_db, cnn
If Not (ret.BOF And ret.EOF) Then
frmpren.Label26.Caption = ret("迁出日期")
frmpren.Label33.Caption = ret("迁往何地")
End If
Unload frmprint
frmpren.Show
frmpt2.Show
frmpren.Enabled = False
mainfrm.Enabled = False
mainfrm.Command5.Enabled = False
End If
End If

End Sub