frmmodifyw.frm

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

      TabIndex        =   23
      Top             =   3048
      Width           =   432
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "保管期限"
      Height          =   216
      Index           =   11
      Left            =   7560
      TabIndex        =   25
      Top             =   1620
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "文件密级"
      Height          =   216
      Index           =   13
      Left            =   7560
      TabIndex        =   29
      Top             =   2580
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "存档情况"
      Height          =   216
      Index           =   14
      Left            =   7560
      TabIndex        =   31
      Top             =   3060
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "文本类别"
      Height          =   216
      Index           =   12
      Left            =   7560
      TabIndex        =   27
      Top             =   2100
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "份数"
      Height          =   216
      Index           =   15
      Left            =   10320
      TabIndex        =   33
      Top             =   1596
      Width           =   432
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "页数"
      Height          =   216
      Index           =   18
      Left            =   10320
      TabIndex        =   39
      Top             =   3036
      Width           =   432
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "页号"
      Height          =   216
      Index           =   16
      Left            =   10320
      TabIndex        =   35
      Top             =   2100
      Width           =   432
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "最后张次"
      Height          =   216
      Index           =   17
      Left            =   9960
      TabIndex        =   37
      Top             =   2580
      Width           =   864
   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            =   4920
      TabIndex        =   3
      Top             =   420
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "全宗号"
      Height          =   216
      Index           =   2
      Left            =   6840
      TabIndex        =   5
      Top             =   420
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "缩微号"
      Height          =   216
      Index           =   3
      Left            =   8400
      TabIndex        =   7
      Top             =   420
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "顺序号"
      Height          =   216
      Index           =   4
      Left            =   10320
      TabIndex        =   9
      Top             =   420
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "档  号"
      Height          =   216
      Index           =   5
      Left            =   2760
      TabIndex        =   11
      Top             =   900
      Width           =   648
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "文件编号"
      Height          =   216
      Index           =   6
      Left            =   6000
      TabIndex        =   13
      Top             =   900
      Width           =   864
   End
   Begin VB.Label LabelW 
      AutoSize        =   -1  'True
      Caption         =   "形成日期"
      Height          =   216
      Index           =   7
      Left            =   9480
      TabIndex        =   15
      Top             =   900
      Width           =   864
   End
End
Attribute VB_Name = "frmModifyW"
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(8) 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 = ListDW.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
ListDW.RemoveItem ListDW.ListIndex
ListDW.Text = ListDW.List(NextIndex)
Call ListRecord
End Sub

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

Private Sub cmdRefilt_Click()
frmModifyW.Hide
Unload frmModifyW
Load frmFilterW
frmFilterW.Show
End Sub

Private Sub CmdReturn_Click()
adoRst.CancelUpdate
adoRst.Close
frmModifyW.Hide
Unload frmModifyW
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("责任者1") = ConvertNull(IIf(dcZR(0).Text = "", -1, ZZID(0)))
  .Fields("责任者2") = ConvertNull(IIf(dcZR(1).Text = "", -1, ZZID(1)))
  .Fields("责任者3") = ConvertNull(IIf(dcZR(2).Text = "", -1, ZZID(2)))
  .Fields("备注") = ConvertNull(Text8.Text)
  .Fields("规格") = ConvertNull(Text9.Text)
  .Fields("保管期限") = ConvertNull(Combo1.Text)
  .Fields("文本类别") = ConvertNull(Combo2.Text)
  .Fields("密级") = ConvertNull(Combo3.Text)
  .Fields("存档情况") = ConvertNull(Combo4.Text)
  .Fields("份数") = ConvertNull(Val(Text10.Text))
  .Fields("页号") = ConvertNull(Val(Text11.Text))
  .Fields("最后张次") = ConvertNull(Val(Text12.Text))
  .Fields("页数") = ConvertNull(Val(Text13.Text))
  .Fields("题名") = ConvertNull(Text14.Text)
  .Fields("摘要") = ConvertNull(Text15.Text)
  
Do While False
  .Fields("责任者1") = ConvertNull(IIf(dcZR(0).Text = "", -1, dcZR(0).BoundText))
  .Fields("责任者2") = ConvertNull(IIf(dcZR(1).Text = "", -1, dcZR(1).BoundText))
  .Fields("责任者3") = ConvertNull(IIf(dcZR(2).Text = "", -1, dcZR(2).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(3)))
  .Fields("主题词2") = ConvertNull(IIf(dcZTC(1).Text = "", -1, ZZID(4)))
  .Fields("主题词3") = ConvertNull(IIf(dcZTC(2).Text = "", -1, ZZID(5)))
  .Fields("主题词4") = ConvertNull(IIf(dcZTC(3).Text = "", -1, ZZID(6)))
  .Fields("主题词5") = ConvertNull(IIf(dcZTC(4).Text = "", -1, ZZID(7)))
  .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 Combo4_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 + 3) = 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 + 3) = 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 DataW 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