📄 frmseekg.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc adoDG
Height = 312
Left = 240
Top = 5880
Visible = 0 'False
Width = 960
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 3
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 1
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 5
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "DSN=PmData"
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "PmData"
OtherAttributes = ""
UserName = "Admin"
Password = ""
RecordSource = "DataG"
Caption = "归档文件"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "摘 要"
Height = 216
Index = 14
Left = 2760
TabIndex = 35
Top = 4920
Width = 648
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "主题词"
Height = 216
Index = 13
Left = 2760
TabIndex = 29
Top = 3900
Width = 648
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "正题名"
Height = 216
Index = 12
Left = 2760
TabIndex = 27
Top = 2880
Width = 648
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "规格"
Height = 216
Index = 9
Left = 9960
TabIndex = 21
Top = 1440
Width = 432
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "存档情况"
Height = 216
Index = 8
Left = 7560
TabIndex = 19
Top = 2400
Width = 864
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "归文密级"
Height = 216
Index = 7
Left = 7560
TabIndex = 17
Top = 1920
Width = 864
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "保管期限"
Height = 216
Index = 6
Left = 7560
TabIndex = 15
Top = 1440
Width = 864
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "页数"
Height = 216
Index = 11
Left = 9960
TabIndex = 25
Top = 2376
Width = 432
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "份数"
Height = 216
Index = 10
Left = 9960
TabIndex = 23
Top = 1896
Width = 432
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "责任者"
Height = 216
Index = 5
Left = 2760
TabIndex = 11
Top = 1440
Width = 648
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "目录号"
Height = 216
Index = 1
Left = 5040
TabIndex = 3
Top = 420
Width = 648
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "档 号"
Height = 216
Index = 2
Left = 7920
TabIndex = 5
Top = 420
Width = 648
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "文件编号"
Height = 216
Index = 3
Left = 2760
TabIndex = 7
Top = 900
Width = 864
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "形成日期"
Height = 216
Index = 4
Left = 7920
TabIndex = 9
Top = 900
Width = 864
End
Begin VB.Label LabelG
AutoSize = -1 'True
Caption = "全宗号"
Height = 216
Index = 0
Left = 2760
TabIndex = 1
Top = 420
Width = 648
End
End
Attribute VB_Name = "frmSeekG"
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 adoCom As ADODB.Command
Dim RecordItem, 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()
frmSeekG.Hide
Unload frmSeekG
Load frmFilterG
frmFilterG.Show
End Sub
Private Sub CmdReturn_Click()
adoRst.CancelUpdate
adoRst.Close
frmSeekG.Hide
Unload frmSeekG
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!形成日期)
Text8.Text = ConvertNull(.Fields!保管期限)
Text9.Text = ConvertNull(.Fields!密级)
Text10.Text = ConvertNull(.Fields!存档情况)
Text11.Text = ConvertNull(LTrim(.Fields!规格))
Text12.Text = ConvertNull(.Fields!份数)
Text13.Text = ConvertNull(.Fields!页数)
Text14.Text = ConvertNull(.Fields!正题名)
Text20.Text = ConvertNull(.Fields!摘要)
End With
With adoZrRst
Zr = adoRst.Fields!责任者1
.MoveFirst
.Find "ZrID=" & Zr
If .EOF Or .BOF Then
Text5.Text = ""
Else
Text5.Text = .Fields!Zr
End If
Zr = adoRst.Fields!责任者2
.MoveFirst
.Find "ZrID=" & Zr
If .EOF Or .BOF Then
Text6.Text = ""
Else
Text6.Text = .Fields!Zr
End If
Zr = adoRst.Fields!责任者3
.MoveFirst
.Find "ZrID=" & Zr
If .EOF Or .BOF Then
Text7.Text = ""
Else
Text7.Text = .Fields!Zr
End If
End With
With adoZtcRst
Ztc = adoRst.Fields!主题词1
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text15.Text = ""
Else
Text15.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词2
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text16.Text = ""
Else
Text16.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词3
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text17.Text = ""
Else
Text17.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词4
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text18.Text = ""
Else
Text18.Text = .Fields!Ztc
End If
Ztc = adoRst.Fields!主题词5
.MoveFirst
.Find "ZtcID=" & Ztc
If .EOF Or .BOF Then
Text19.Text = ""
Else
Text19.Text = .Fields!Ztc
End If
End With
End Sub
Private Sub Form_Load()
Dim sSQL As String
Set adoCon = New ADODB.Connection
Set adoRst = New ADODB.Recordset
Set adoZrRst = New ADODB.Recordset
Set adoZtcRst = New ADODB.Recordset
Set adoCom = New ADODB.Command
adoCon.CursorLocation = adUseClient
adoCon.Open "PmData", "", ""
Set adoRst.ActiveConnection = adoCon
Set adoZrRst.ActiveConnection = adoCon
Set adoZtcRst.ActiveConnection = adoCon
adoRst.LockType = adLockReadOnly
adoRst.CursorType = adOpenKeyset
'使用 Filter 方法：
' adoRst.Open "Select * From DataG Where FileType Like '" & _
frmMain.FileType & "' Order By 档号 "
' adoRst.Filter = "FileType='" & frmMain.FileType & "'" & frmFtype.FilterText
'使用 SQL 方法："adoRst.Open sSQL"
sSQL = "Select * From DataG 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 ListDH() '档号列表
With adoRst
Do Until .EOF
ListDG.AddItem adoRst!档号
.MoveNext
Loop
If .RecordCount = 0 Then
MsgBox "此档案不存在！"
Else
.MoveFirst
ListDG.Text = ListDG.List(0)
End If
End With
End Sub
Private Sub ListDG_Click() '选择档号
adoRst.MoveFirst
adoRst.Find "档号 Like " & ListDG.Text
If adoRst.EOF Or adoRst.BOF Then
MsgBox "找不到相应的档号！"
Else
Call ListRecord
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -