frmmodifya.frm

档案管理系统,使用vb6+access数据库开发

      Left            =   8040
      TabIndex        =   25
      Top             =   2100
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "存档情况"
      Height          =   216
      Index           =   13
      Left            =   8040
      TabIndex        =   27
      Top             =   2580
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "份数"
      Height          =   216
      Index           =   15
      Left            =   10320
      TabIndex        =   31
      Top             =   2100
      Width           =   432
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "页数"
      Height          =   216
      Index           =   16
      Left            =   10320
      TabIndex        =   33
      Top             =   2580
      Width           =   432
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "分类号"
      Height          =   216
      Index           =   0
      Left            =   2760
      TabIndex        =   1
      Top             =   420
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "目录号"
      Height          =   216
      Index           =   1
      Left            =   5400
      TabIndex        =   3
      Top             =   420
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "全宗号"
      Height          =   216
      Index           =   2
      Left            =   7680
      TabIndex        =   5
      Top             =   420
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "档  号"
      Height          =   216
      Index           =   4
      Left            =   2760
      TabIndex        =   9
      Top             =   900
      Width           =   648
   End
End
Attribute VB_Name = "frmModifyA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoCon As ADODB.Connection
Dim adoRst, adoZrRst, adoZtcRst As ADODB.Recordset
Dim ThisItem, LastItem, ZZID(7) As Integer

Private Function ConvertNull(para_Value As Variant) As Variant
  If IsNull(para_Value) = True Then
     ConvertNull = ""
  Else
     ConvertNull = para_Value
  End If
End Function

Private Sub cmdDelete_Click()
Dim NextIndex As Integer
NextIndex = ListDA.ListIndex
With adoRst
  .Delete adAffectCurrent
  .MoveNext
  If .EOF Then
     NextIndex = NextIndex - 1
     If NextIndex < 0 Then
        frmMain.FileManage = 4
        MsgBox "符合要求的档案不存在，按[确定]键后重新过滤数据。"
        Call cmdRefilt_Click
        Exit Sub
     End If
     .MoveLast
  End If
End With
ListDA.RemoveItem ListDA.ListIndex
ListDA.Text = ListDA.List(NextIndex)
Call ListRecord
End Sub

Private Sub cmdModify_Click()
Call SetEnable(True)
Text0.SetFocus
End Sub

Private Sub cmdRefilt_Click()
frmModifyA.Hide
Unload frmModifyA
Load frmFilterA
frmFilterA.Show
End Sub

Private Sub CmdReturn_Click()
adoRst.CancelUpdate
adoRst.Close
frmModifyA.Hide
Unload frmModifyA
End Sub

Private Sub cmdRevert_Click()
Call ListRecord
End Sub

Private Sub cmdUpdate_Click()
On Error GoTo Error_Handle

With adoRst
  .Fields("分类号") = ConvertNull(Text0.Text)
  .Fields("目录号") = ConvertNull(Text1.Text)
  .Fields("全宗号") = ConvertNull(Text2.Text)
  .Fields("年度") = ConvertNull(Text3.Text)
  .Fields("档号") = ConvertNull(Text4.Text)
  .Fields("档案室代号") = ConvertNull(Text5.Text)
  .Fields("分类名") = ConvertNull(Text6.Text)
  .Fields("开始日期") = ConvertNull(Text7.Text)
  .Fields("最后日期") = ConvertNull(Text8.Text)
  .Fields("全宗名称") = ConvertNull(IIf(dcZR(0).Text = "", -1, ZZID(0)))
  .Fields("归档单位") = ConvertNull(IIf(dcZR(1).Text = "", -1, ZZID(1)))
  .Fields("保管期限") = ConvertNull(Combo1.Text)
  .Fields("密级") = ConvertNull(Combo2.Text)
  .Fields("存档情况") = ConvertNull(Combo3.Text)
  .Fields("规格") = ConvertNull(Text9.Text)
  .Fields("份数") = ConvertNull(Val(Text10.Text))
  .Fields("页数") = ConvertNull(Val(Text11.Text))
  .Fields("正题名") = ConvertNull(Text12.Text)
  .Fields("摘要") = ConvertNull(Text13.Text)

Do While False
  .Fields("全宗名称") = ConvertNull(IIf(dcZR(0).Text = "", -1, dcZR(0).BoundText))
  .Fields("归档单位") = ConvertNull(IIf(dcZR(1).Text = "", -1, dcZR(1).BoundText))
  .Fields("主题词1") = ConvertNull(IIf(dcZTC(0).Text = "", -1, dcZTC(0).BoundText))
  .Fields("主题词2") = ConvertNull(IIf(dcZTC(1).Text = "", -1, dcZTC(1).BoundText))
  .Fields("主题词3") = ConvertNull(IIf(dcZTC(2).Text = "", -1, dcZTC(2).BoundText))
  .Fields("主题词4") = ConvertNull(IIf(dcZTC(3).Text = "", -1, dcZTC(3).BoundText))
  .Fields("主题词5") = ConvertNull(IIf(dcZTC(4).Text = "", -1, dcZTC(4).BoundText))
Loop

  .Fields("主题词1") = ConvertNull(IIf(dcZTC(0).Text = "", -1, ZZID(2)))
  .Fields("主题词2") = ConvertNull(IIf(dcZTC(1).Text = "", -1, ZZID(3)))
  .Fields("主题词3") = ConvertNull(IIf(dcZTC(2).Text = "", -1, ZZID(4)))
  .Fields("主题词4") = ConvertNull(IIf(dcZTC(3).Text = "", -1, ZZID(5)))
  .Fields("主题词5") = ConvertNull(IIf(dcZTC(4).Text = "", -1, ZZID(6)))
  .Update
End With
cmdModify.Enabled = True
cmdModify.Enabled = True
cmdUpdate.Enabled = False
cmdRevert.Enabled = False
Exit Sub

Error_Handle:
  MsgBox "保存失败！"
  adoRst.CancelUpdate
  adoRst.MoveFirst
  Call ListRecord
  Resume Next
End Sub


Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Combo3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub dcZR_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub dcZR_LostFocus(Index As Integer)
Dim NewZr As Boolean
Dim NewID As Integer
If LTrim(Trim(dcZR(Index).Text)) = "" Then Exit Sub
NewZr = True
NewID = 0
With adoZrRst
  '.Open "Select * From Zr Order By ZrID"
  .MoveFirst
  Do Until .EOF
     If Trim(.Fields("ZrID")) = NewID Then NewID = NewID + 1
     If Trim(.Fields("Zr")) = Trim(dcZR(Index).Text) Then
        NewZr = False
        ZZID(Index) = Val(dcZR(Index).BoundText)
        Exit Do
     End If
     .MoveNext
  Loop
  .MoveFirst
  If NewZr Then
     .AddNew
     .Fields("ZrID") = NewID
     .Fields("Zr") = dcZR(Index).Text
     .Update
     ZZID(Index) = NewID
     'dcZR(Index).ReFill
  End If
  '.Close
End With
End Sub

Private Sub dcZTC_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub dcZTC_LostFocus(Index As Integer)
Dim NewZtc As Boolean
Dim NewID As Integer
If LTrim(Trim(dcZTC(Index).Text)) = "" Then Exit Sub
NewZtc = True
NewID = 0
With adoZtcRst
  '.Open "Select * From Ztc Order By ZtcID"
  .MoveFirst
  Do Until .EOF
     If Trim(.Fields("ZtcID")) = NewID Then NewID = NewID + 1
     If Trim(.Fields("Ztc")) = Trim(dcZTC(Index).Text) Then
        NewZtc = False
        ZZID(Index) = Val(dcZTC(Index).BoundText)
        Exit Do
     End If
     .MoveNext
  Loop
  .MoveFirst
  If NewZtc Then
     .AddNew
     .Fields("ZtcID") = NewID
     .Fields("Ztc") = dcZTC(Index).Text
     .Update
     ZZID(Index) = NewID
     'dcZTC(Index).ReFill
  End If
  '.Close
End With
End Sub

Private Sub Form_Load()
  Set adoCon = New ADODB.Connection
  adoCon.Open "PmData", "Admin"
  
  Set adoRst = New ADODB.Recordset
  Set adoRst.ActiveConnection = adoCon
  adoRst.CursorType = adOpenDynamic
  adoRst.LockType = adLockOptimistic
  
  Set adoZrRst = New ADODB.Recordset
  Set adoZrRst.ActiveConnection = adoCon
  adoZrRst.CursorType = adOpenDynamic
  adoZrRst.LockType = adLockOptimistic
 
  Set adoZtcRst = New ADODB.Recordset
  Set adoZtcRst.ActiveConnection = adoCon
  adoZtcRst.CursorType = adOpenDynamic
  adoZtcRst.LockType = adLockOptimistic
  
  Dim sSQL As String
  
  sSQL = "Select * From DataA Where FileType Like '" & frmMain.FileType & _
           "' " & frmFtype.FilterText & " Order By 档号"
  adoRst.Open sSQL
  adoZrRst.Open "Select * From Zr Order By ZrID"
  adoZtcRst.Open "Select * From Ztc Order By ZtcID"
  
  Call ListDH   '调用档号列表
End Sub

Private Sub ListRecord()
Dim Zr, Ztc, i As Integer

With adoRst
  Text0.Text = ConvertNull(.Fields!分类号)
  Text1.Text = ConvertNull(.Fields!目录号)
  Text2.Text = ConvertNull(.Fields!全宗号)
  Text3.Text = ConvertNull(.Fields!年度)
  Text4.Text = ConvertNull(.Fields!档号)
  Text5.Text = ConvertNull(.Fields!档案室代号)
  Text6.Text = ConvertNull(.Fields!分类名)
  Text7.Text = ConvertNull(.Fields!开始日期)
  Text8.Text = ConvertNull(.Fields!最后日期)
  Combo1.Text = ConvertNull(.Fields!保管期限)
  Combo2.Text = ConvertNull(.Fields!密级)
  Combo3.Text = ConvertNull(.Fields!存档情况)
  Text9.Text = ConvertNull(LTrim(.Fields!规格))
  Text10.Text = ConvertNull(.Fields!份数)
  Text11.Text = ConvertNull(.Fields!页数)
  Text12.Text = ConvertNull(.Fields!正题名)
  Text13.Text = ConvertNull(.Fields!摘要)
End With

With adoZrRst
  Zr = adoRst.Fields!全宗名称
  .MoveFirst
  .Find "ZrID=" & Zr
  If .EOF Or .BOF Then
     dcZR(0).Text = ""
  Else
     dcZR(0).Text = .Fields!Zr
  End If

  Zr = adoRst.Fields!归档单位
  .MoveFirst
  .Find "ZrID=" & Zr
  If .EOF Or .BOF Then
     dcZR(1).Text = ""
  Else
     dcZR(1).Text = .Fields!Zr
  End If
End With

With adoZtcRst
  Ztc = adoRst.Fields!主题词1
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(0).Text = ""
  Else
     dcZTC(0).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词2
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(1).Text = ""
  Else
     dcZTC(1).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词3
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(2).Text = ""
  Else
     dcZTC(2).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词4
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(3).Text = ""
  Else
     dcZTC(3).Text = .Fields!Ztc
  End If

  Ztc = adoRst.Fields!主题词5
  .MoveFirst
  .Find "ZtcID=" & Ztc
  If .EOF Or .BOF Then
     dcZTC(4).Text = ""
  Else
     dcZTC(4).Text = .Fields!Ztc
  End If
End With