Private Sub cmdYes_Click()
On Error Resume Next
Dim sqlZBQKB As String
Dim sqlJTQKB As String
'檢測數據
Checked = True
CheckItem
'輸入數據
 If Checked Then
 
    '輸入基本庫數據
    
    sqlZBQKB = "insert into Party(xh,xm,csny,mz,yx,nj,sy,xl,tgsj,zzsj,zdsj,zddd) "
    sqlZBQKB = sqlZBQKB + "values('" + Trim(txtXH) + "','" + Trim(txtXM) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(CDate(MSKCSNY)) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboMZ) + "','" + Trim(cboYX) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboNJ) + "','" + Trim(cboSY) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboXL) + "','" + Trim(CDate(MSKTGSJ)) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(CDate(MSKZZSJ)) + "','" + Trim(CDate(MSKZDSJ)) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(txtZDDD) + "')"
    Dbstudent.Execute sqlZBQKB
    ' 初始化數據
    If MsgBox("繼續添加下一條記錄?", vbQuestion + vbYesNo) = vbYes Then
    InitItem
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Command6.Enabled = False
    Exit Sub
    Else
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    Command6.Enabled = True
    cmdExit.Enabled = True
    Data1.Refresh
    Data1.Recordset.MoveLast
    cmdYes.Enabled = False
    Exit Sub
    End If
    
 Else
    Data1.Refresh
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    Command6.Enabled = True
    Exit Sub
 End If
 
 AddNew = False
 Data1.Recordset.MoveLast
 Data1.Recordset.MoveFirst
 SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "條記錄!"

End Sub

Public Sub CheckItem()
'檢查數據重復
On Error Resume Next
Dim sqlRepeat As String
Dim recRepeat As Recordset

'檢查重復
sqlRepeat = "select * from party where xh='" + Trim(txtXH) + "'"
Set recRepeat = Dbstudent.OpenRecordset(sqlRepeat, dbOpenSnapshot)
If recRepeat.RecordCount <> 0 Then
    MsgBox "庫中已有該同學記錄！", vbInformation + vbOKOnly, "提示"
    txtXH = ""
    txtXH.SetFocus
    Checked = False
    Exit Sub
End If
'測試出生日期
If MSKCSNY = "" Then
   MSKCSNY = "2000-01-01"
Else
   If Not IsDate(MSKCSNY) Then
      MsgBox "出生日期輸入不正確!", vbCritical + vbOKOnly, "錯誤"
      MSKCSNY = ""
      MSKCSNY.SetFocus
      Checked = False
      Exit Sub
   End If
End If
'測試通過時間
If MSKTGSJ = "" Then
   MSKTGSJ = "2000-01-01"
Else
   If Not IsDate(MSKTGSJ) Then
      MsgBox "通過日期輸入不正確!", vbCritical + vbOKOnly, "錯誤"
      MSKTGSJ = ""
      MSKTGSJ.SetFocus
      Checked = False
      Exit Sub
   End If
End If
'測試轉正時間
If MSKZZSJ = "" Then
   MSKZZSJ = "2000-01-01"
Else
   If Not IsDate(MSKZZSJ) Then
      MsgBox "轉正日期輸入不正確!", vbCritical + vbOKOnly, "錯誤"
      MSKZZSJ = ""
      MSKZZSJ.SetFocus
      Checked = False
      Exit Sub
   End If
End If
'測試轉檔時間
If MSKZDSJ = "" Then
   MSKZDSJ = "2000-01-01"
Else
   If Not IsDate(MSKZDSJ) Then
      MsgBox "轉檔日期輸入不正確!", vbCritical + vbOKOnly, "錯誤"
      MSKZDSJ = ""
      MSKZDSJ.SetFocus
      Checked = False
      Exit Sub
   End If
End If
End Sub

Public Sub InitItem()
'初始化數據
On Error Resume Next
txtXH = ""
txtXM = ""
MSKCSNY = ""
cboMZ = ""
cboYX = ""
cboNJ = ""
cboSY = ""
cboXL = ""
MSKTGSJ = ""
MSKZZSJ = ""
MSKZDSJ = ""
txtZDDD = ""
txtXH.SetFocus
End Sub

Private Sub Command1_Click()
On Error Resume Next
Data1.Recordset.MoveFirst
End Sub

Private Sub Command2_Click()
On Error Resume Next
If txtXH.Text <> "" Then
Data1.Recordset.MoveLast
SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "條記錄"
End If

End Sub

Private Sub Command3_Click()
On Error Resume Next
Data1.Recordset.MovePrevious
If Data1.Recordset.BOF Then
Data1.Recordset.MoveFirst
MsgBox "這是第一條記錄!", vbInformation + vbOKOnly, "消息提示框"
End If

End Sub
Private Sub Command4_Click()
On Error Resume Next
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Data1.Recordset.MoveLast
MsgBox "這是最后一條記錄!", vbInformation + vbOKOnly, "信息提示"
Exit Sub
End If

End Sub

Private Sub Command5_Click()
On Error Resume Next
AddNew = True
InitItem
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command6.Enabled = False
cmdExit.Enabled = False
End Sub

Private Sub Command6_Click()
On Error Resume Next
If txtXH.Text = "" Then
MsgBox "無記錄供刪除!", vbInformation + vbOKOnly, "提示框"
Exit Sub
End If
If MsgBox("確信要刪除?", vbQuestion + vbYesNo, "刪除前詢問") = vbYes Then
Dim sqlDelete As String
sqlDelete = "delete from party where xh='" + txtXH + "'"
Dbstudent.Execute sqlDelete, 64
Data1.Refresh
Data1.Recordset.MoveFirst
Data1.Recordset.MoveLast
End If
SBar1.Panels.Item(1).Text = "刪除了一條記錄！"
SBar1.Panels.Item(2).Text = "還有" & (Data1.Recordset.RecordCount) & "條記錄!"

End Sub

Private Sub Data1_Reposition()
On Error Resume Next

SBar1.Panels.Item(1).Text = "第" & Data1.Recordset.AbsolutePosition + 1 & "條"
SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "條記錄"
End Sub

Private Sub Form_Load()
On Error Resume Next
AddNew = False
ComboData
Dim rec As Recordset
Set rec = Dbstudent.OpenRecordset("select * from party", dbOpenDynaset)
Set Data1.Recordset = rec
Line1.X1 = 0
Line1.X2 = frmPartyInput.Width
rec.MoveLast
rec.MoveFirst
SBar1.Panels.Item(1).Text = "第" & Data1.Recordset.AbsolutePosition + 1 & "條"
SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "條記錄"
End Sub


Public Sub ComboData()
 On Error Resume Next
 With cboMZ
  .AddItem "漢族"
  .AddItem "回族"
  .AddItem "藏族"
  .AddItem "滿族"
  .AddItem "壯族"
 End With
 With cboXL
  .AddItem "博士"
  .AddItem "碩士"
  .AddItem "本科"
  .AddItem "大專"
  .AddItem "進修生"
  .AddItem "雙學士"
End With
With cboSY
  .AddItem "北京"
  .AddItem "天津"
  .AddItem "上海"
  .AddItem "重慶"
  .AddItem "黑龍"
  .AddItem "吉林"
  .AddItem "遼寧"
  .AddItem "內蒙"
  .AddItem "河北"
  .AddItem "河南"
  .AddItem "山西"
  .AddItem "陜西"
  .AddItem "寧夏"
  .AddItem "甘肅"
  .AddItem "青海"
  .AddItem "新疆"
  .AddItem "西藏"
  .AddItem "四川"
  .AddItem "云南"
  .AddItem "貴州"
  .AddItem "廣西"
  .AddItem "廣東"
  .AddItem "福建"
  .AddItem "江西"
  .AddItem "湖南"
  .AddItem "湖北"
  .AddItem "山東"
  .AddItem "安徽"
  .AddItem "江蘇"
  .AddItem "浙江"
End With
With cboYX
  .AddItem "船舶與海洋工程學院"
  .AddItem "動力與能源工程學院"
  .AddItem "電子信息學院"
  .AddItem "電力與能源學院"
  .AddItem "材料科學與工程學院"
  .AddItem "機械工程學院"
  .AddItem "理學院"
  .AddItem "人文社會科學學院"
  .AddItem "生命技術科學學院"
  .AddItem "建筑工程力學學院"
  .AddItem "外國語學院"
  .AddItem "塑性成形工程系"
  .AddItem "體育系"
End With
With cboNJ
  .AddItem "94級"
  .AddItem "95級"
  .AddItem "96級"
  .AddItem "97級"
  .AddItem "98級"
  .AddItem "99級"
  .AddItem "2000級"
End With
End Sub
Public Function XHInZBQKB(ByVal XH As String) As Boolean
On Error Resume Next
Dim sqlFind As String
Dim recFind As Recordset
sqlFind = "select * from zbqkb where xh='" + Trim(txtXH) + "'"
Set recFind = Dbstudent.OpenRecordset(sqlFind, dbOpenSnapshot)
XHInZBQKB = True
If recFind.RecordCount = 0 Then
    XHInZBQKB = False
End If
End Function

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
End Sub

Private Sub MNUADD_Click()
On Error Resume Next
Call Command5_Click
End Sub

Private Sub MNUDELE_Click()
On Error Resume Next
Call Command6_Click
End Sub

Private Sub MNUCOU_Click()
frmPartyCount.Show 1
End Sub

Private Sub MNUEXIT_Click()
On Error Resume Next
Call cmdExit_Click
End Sub

Private Sub MNULOC_Click()
FRMDW.Label1.Caption = "黨員庫學號定位"
FRMDW.Show 1
End Sub

Private Sub MNUNOTE_Click()
Dim TTT As String
Dim X
TTT = App.Path + "\help\partyin.txt"
X = Shell("Notepad " + TTT, 1)
End Sub

Private Sub mnurep_Click()
frmPartyModify.Show 1
End Sub

Private Sub MNUSQU_Click()
frmQueryParty.Show 1
End Sub

Private Sub txtXH_LostFocus()
On Error Resume Next
Dim sqlRepeat As String
Dim recRepeat As Recordset
Dim sqlOld As String
Dim recOld As Recordset
Dim Year0 As String
Dim Month0 As String
Dim Day0 As String
'學號未填

If Not AddNew Then
    Exit Sub
End If

If txtXH = "" Then
   MsgBox "學號未填寫!", vbInformation + vbOKOnly, "錯誤"
   txtXH.SetFocus
   Exit Sub
End If

If Not XHInZBQKB(txtXH) Then
    MsgBox "基本庫中未發現此學生信息!", vbQuestion + vbYesNo, "錯誤"
   txtXH = " "
   txtXH.SetFocus
   Exit Sub
End If

sqlRepeat = "select * from party where xh='" + Trim(txtXH) + "'"
Set recRepeat = Dbstudent.OpenRecordset(sqlRepeat, dbOpenSnapshot)
If recRepeat.RecordCount <> 0 Then
    MsgBox "學號有重復！", vbInformation + vbOKOnly, "提示"
    Dim s As String
    s = Trim(txtXH)
    Data1.Recordset.MoveFirst
    Data1.Refresh
    Data1.Recordset.FindFirst "xh='" + Trim(s) + "'"
    AddNew = False
    txtXH.SetFocus
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    cmdExit.Enabled = True
    cmdYes.Enabled = False
    Command5.Enabled = True
    Command6.Enabled = True
    Exit Sub
Else
'End If
'測試出生日期
sqlOld = "select top 1  xh,xm,csny,sy,mz,yx,nj,xl from zbqkb where xh='" + Trim(txtXH) + "'"
Set recOld = Dbstudent.OpenRecordset(sqlOld, dbOpenSnapshot)
If Not IsNull(recOld!XH) Then txtXH = recOld!XH
If Not IsNull(recOld!XM) Then txtXM = recOld!XM
If Not IsNull(recOld!XL) Then cboXL = recOld!XL
If Not IsNull(recOld!YX) Then cboYX = recOld!YX
If Not IsNull(recOld!NJ) Then cboNJ = recOld!NJ
If Not IsNull(recOld!SY) Then cboSY = recOld!SY
If Not IsNull(recOld!MZ) Then cboMZ = recOld!MZ
If Not IsNull(recOld!CSNY) Then
    If Len(Year(recOld!CSNY)) = 2 Then
        Year0 = Right("19" & CStr(Year(recOld!CSNY)), 2)
    Else
        Year0 = Right(CStr(Year(recOld!CSNY)), 2)
    End If
    If Len(Month(recOld!CSNY)) = 1 Then
        Month0 = "0" & CStr(Month(recOld!CSNY))
    Else
        Month0 = CStr(Month(recOld!CSNY))
    End If
    If Len(Day(recOld!CSNY)) = 1 Then
        Day0 = "0" & CStr(Day(recOld!CSNY))
    Else
        Day0 = CStr(Day(recOld!CSNY))
    End If
    MSKCSNY = Year0 + "-" + Month0 + "-" + Day0
cmdYes.Enabled = True
End If
End If

End Sub