📄 frmseeka.frm
字号:
Top = 2580
Width = 864
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "最后日期"
Height = 216
Index = 10
Left = 5160
TabIndex = 21
Top = 2580
Width = 864
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "归档单位"
Height = 216
Index = 8
Left = 2760
TabIndex = 17
Top = 2100
Width = 864
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "分类名"
Height = 216
Index = 6
Left = 8760
TabIndex = 13
Top = 900
Width = 648
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "档案室代号"
Height = 216
Index = 5
Left = 6120
TabIndex = 11
Top = 900
Width = 1080
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "案卷年度"
Height = 216
Index = 3
Left = 9720
TabIndex = 7
Top = 420
Width = 864
End
Begin VB.Line Line2
BorderColor = &H80000003&
Index = 3
X1 = 9804
X2 = 9804
Y1 = 1344
Y2 = 2988
End
Begin VB.Line Line2
BorderColor = &H80000005&
Index = 2
X1 = 9828
X2 = 9828
Y1 = 1344
Y2 = 2988
End
Begin VB.Line Line2
BorderColor = &H80000003&
Index = 1
X1 = 7476
X2 = 7476
Y1 = 1344
Y2 = 2988
End
Begin VB.Line Line2
BorderColor = &H80000005&
Index = 0
X1 = 7500
X2 = 7500
Y1 = 1344
Y2 = 2988
End
Begin VB.Line Line1
BorderColor = &H80000003&
Index = 5
X1 = 2640
X2 = 11800
Y1 = 5160
Y2 = 5160
End
Begin VB.Line Line1
BorderColor = &H80000005&
Index = 4
X1 = 2640
X2 = 11800
Y1 = 5172
Y2 = 5172
End
Begin VB.Line Line1
BorderColor = &H80000003&
Index = 1
X1 = 2640
X2 = 11800
Y1 = 3000
Y2 = 3000
End
Begin VB.Line Line1
BorderColor = &H80000005&
Index = 0
X1 = 2640
X2 = 11800
Y1 = 3012
Y2 = 3012
End
Begin VB.Line Line1
BorderColor = &H80000003&
Index = 3
X1 = 2640
X2 = 11800
Y1 = 1320
Y2 = 1320
End
Begin VB.Line Line1
BorderColor = &H80000005&
Index = 2
X1 = 2640
X2 = 11800
Y1 = 1332
Y2 = 1332
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "正题名"
Height = 216
Index = 17
Left = 2760
TabIndex = 35
Top = 3240
Width = 648
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "主题词"
Height = 216
Index = 18
Left = 2760
TabIndex = 37
Top = 4272
Width = 648
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "摘 要"
Height = 216
Index = 19
Left = 2760
TabIndex = 43
Top = 5400
Width = 648
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "全宗名称"
Height = 216
Index = 7
Left = 2760
TabIndex = 15
Top = 1620
Width = 864
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "规格"
Height = 216
Index = 14
Left = 10200
TabIndex = 29
Top = 1608
Width = 432
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "保管期限"
Height = 216
Index = 11
Left = 7800
TabIndex = 23
Top = 1620
Width = 864
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "案卷密级"
Height = 216
Index = 12
Left = 7800
TabIndex = 25
Top = 2100
Width = 864
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "存档情况"
Height = 216
Index = 13
Left = 7800
TabIndex = 27
Top = 2580
Width = 864
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "份数"
Height = 216
Index = 15
Left = 10200
TabIndex = 31
Top = 2100
Width = 432
End
Begin VB.Label LabelW
AutoSize = -1 'True
Caption = "页数"
Height = 216
Index = 16
Left = 10200
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 = "frmSeekA"
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 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 cmdRefilt_Click()
frmSeekA.Hide
Unload frmSeekA
Load frmFilterA
frmFilterA.Show
End Sub
Private Sub CmdReturn_Click()
adoRst.CancelUpdate
adoRst.Close
frmSeekA.Hide
Unload frmSeekA
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"
adoZtcRst.Open "Select * From ZTC"
Call ListDH '调用档号列表
End Sub
Private Sub ListRecord()
Dim Zr, Ztc 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!分类名)
Text9.Text = ConvertNull(.Fields!开始日期)
Text10.Text = ConvertNull(.Fields!最后日期)
Text11.Text = ConvertNull(.Fields!保管期限)
Text12.Text = ConvertNull(.Fields!密级)
Text13.Text = ConvertNull(.Fields!存档情况)
Text14.Text = LTrim(ConvertNull(.Fields!规格))
Text15.Text = .Fields!份数
Text16.Text = .Fields!页数
Text17.Text = ConvertNull(.Fields!正题名)
Text23.Text = ConvertNull(.Fields!摘要)
End With
With adoZrRst
Zr = adoRst.Fields!全宗名称
.MoveFirst
.Find "ZrID=" & Zr
If .EOF Or .BOF Then
Text7.Text = ""
Else
Text7.Text = .Fields!Zr
End If
Zr = adoRst.Fields!归档单位
.MoveFirst
.Find "ZrID=" & Zr
If .EOF Or .BOF Then
Text8.Text = ""
Else
Text8.Text = .Fields!Zr
End If
End With
With adoZtcRst
Ztc = adoRst.Fields!主题词1
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text18.Text = ""
Else
Text18.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词2
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text19.Text = ""
Else
Text19.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词3
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text20.Text = ""
Else
Text20.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词4
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text21.Text = ""
Else
Text21.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词5
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text22.Text = ""
Else
Text22.Text = .Fields!Ztc
End If
End With
End Sub
Private Sub ListDH() '档号列表
With adoRst
Do Until .EOF
ListDA.AddItem adoRst!档号
.MoveNext
Loop
If .RecordCount = 0 Then
MsgBox "此档案不存在！"
Else
.MoveFirst
ListDA.Text = ListDA.List(0)
LastItem = ListDA.ListIndex
ThisItem = LastItem
End If
End With
End Sub
Private Sub ListDA_Click()
Dim SkipNum, i As Integer
ThisItem = ListDA.ListIndex
SkipNum = ThisItem - LastItem
If SkipNum <> 0 Then
If SkipNum > 0 Then
For i = 1 To SkipNum
adoRst.MoveNext
Next
Else
For i = 1 To -SkipNum
adoRst.MovePrevious
Next
End If
End If
LastItem = ThisItem
Call ListRecord
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -