📄 form_mediav.frm
字号:
Height = 180
Left = 2295
TabIndex = 44
Top = 3105
Width = 540
End
Begin VB.Label Label18
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "案卷内数码文件大小合计"
Height = 180
Left = 1470
TabIndex = 17
Top = 7950
Visible = 0 'False
Width = 1980
End
Begin VB.Label Label17
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数码文件格式"
Height = 180
Left = 4860
TabIndex = 16
Top = 7920
Visible = 0 'False
Width = 1080
End
Begin VB.Label Label16
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "全宗号"
Height = 180
Left = 690
TabIndex = 15
Top = 3120
Width = 540
End
Begin VB.Label Label14
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "主题词"
Height = 180
Left = 690
TabIndex = 14
Top = 3540
Width = 540
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备注"
Height = 180
Left = 690
TabIndex = 13
Top = 3960
Width = 360
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "载体类型"
Height = 180
Left = 690
TabIndex = 12
Top = 2280
Width = 720
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "载体数量"
Height = 180
Left = 4050
TabIndex = 11
Top = 2250
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "起始时间"
Height = 180
Left = 690
TabIndex = 10
Top = 1440
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密级"
Height = 180
Left = 4050
TabIndex = 9
Top = 2670
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "题名"
ForeColor = &H000000C0&
Height = 180
Left = 690
TabIndex = 8
Top = 1020
Width = 360
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "室编档号"
ForeColor = &H000000C0&
Height = 180
Left = 690
TabIndex = 7
Top = 600
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "隶书"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1950
TabIndex = 6
Top = 90
Width = 180
End
Begin VB.Label Label15
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "归档年份"
ForeColor = &H000000C0&
Height = 180
Left = 690
TabIndex = 5
Top = 1860
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录时间"
Height = 180
Left = 4185
TabIndex = 4
Top = 5010
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录者"
Height = 180
Left = 705
TabIndex = 3
Top = 5070
Width = 540
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "片长(分钟)"
Height = 180
Left = 4050
TabIndex = 2
Top = 1830
Width = 900
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "终止时间"
Height = 180
Left = 4050
TabIndex = 1
Top = 1410
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "保管期限"
Height = 180
Left = 690
TabIndex = 0
Top = 2700
Width = 720
End
End
Attribute VB_Name = "form_MediaV"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Command1_Click()
On Error GoTo e:
If DTPicker3.Value < DTPicker2.Value Then MsgBox "终止时间必须大于起始时间！", 48, "": Exit Sub
If fand("T_ARCHIVE_0201_volume", Text3.text) > 0 Then
If flag = "Insert" Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
Exit Sub
ElseIf Not (strfile = Text3.text) Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
Exit Sub
End If
End If
If Text3.text = "" Or Text3.text = " " Then
MsgBox "请输入室编档号！", vbExclamation, ""
Exit Sub
End If
If Text1.text = "" Or Text1.text = " " Then
MsgBox "请输入题名！", vbExclamation, ""
Exit Sub
End If
If Len(Text9.text) <> 4 Then
MsgBox "归档年份请输入4位!", 48, ""
Exit Sub
End If
'归档年分位数判断
If Me.DTPicker3.Value < Me.DTPicker2.Value Then
MsgBox "终止时间不应小于起始时间！", 48, ""
Exit Sub
End If
If flag = "Insert" Then
flagWhere = ""
Dim sum As Integer
If Text5.text <> "" And Text6.text <> "" And Text7.text <> "" And Text12.text <> "" And Text13.text <> "" Then
strSql = "select count(*) from T_ARCHIVE_0201_volume where FONDS_CODE='" & Text5.text & "' and CATALOG_CODE='" & Text6.text & "' and FILE_NUMBER='" & Text7.text & "' and sort_code='" & Text14.text & "' and series_code='" & Text15.text & "'"
'MsgBox strSql
rs.Open strSql, conn
sum = rs.Fields(0).Value
'MsgBox sum
rs.Close
If sum > 0 Then
MsgBox "档号重复,请核查!", vbExclamation, ""
Exit Sub
End If
End If '档号重复判断
num = id("T_ARCHIVE_0201_VOLUME")
strSql = "insert into T_ARCHIVE_0201_VOLUME ("
strSql = strSql + "RECORD_SEQUENCE_NUMBER,TITLE_PROPER,DISCRIPTOR,REFERENCE_CODE_OF_FILE_OFFICE"
strSql = strSql + ",DESCRIBING_DATE,file_MEDIUM,PERSON_FOR_DESCRIPTION,FONDS_CODE"
strSql = strSql + ",CATALOG_CODE,FILE_NUMBER,ARCHIVE_YEAR,DATE_BEGUN"
strSql = strSql + ",DATE_FINISHED,SECRET_LEVEL_FOR_DOCUMENTS,RETENTION_PERIOD,NOTES_OF_ARCHIVIST"
strSql = strSql + ",QUANTITY,MEDIUM_QUANTITY,FILE_SIZE,FILE_TYPE"
strSql = strSql + ",CLASS_CODE,flag"
strSql = strSql + ",SORT_CODE,SERIES_CODE,IS_SHARING"
strSql = strSql + ")values("
strSql = strSql + "" & num & ",'" & Text1.text & "','" & Text2.text & "','" & Text3.text & "' ,'" & Format(DTPicker1.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",'" & Text4.text & "','" & Text8.text & "','" & Text5.text & "','" & Text6.text & "'"
strSql = strSql + ",'" & Text7.text & "','" & Text9.text & "','" & Format(DTPicker2.Value, "yyyy-mm-dd") & "','" & Format(DTPicker3.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",'" & Combo1.ListIndex & "' ,'" & Combo2.ListIndex & "','" & Text11.text & "'"
strSql = strSql + "," & Text12.text & "," & Text10.text & "," & Text13.text & ",'" & Combo3.text & "'"
strSql = strSql + ",'" & form_AnJuan.List1.ListIndex & "',0"
strSql = strSql + ",'" & Text14.text & "','" & Text15.text & "','" & Check1.Value & "'"
strSql = strSql + ")"
ElseIf flag = "Modify" Then
strSql = "update T_ARCHIVE_0201_VOLUME set "
strSql = strSql + "TITLE_PROPER ='" & Text1.text & "' ,DISCRIPTOR ='" & Text2.text & "' ,REFERENCE_CODE_OF_FILE_OFFICE ='" & Text3.text & "' ,DESCRIBING_DATE ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' "
strSql = strSql + ",file_MEDIUM ='" & Text4.text & "' ,PERSON_FOR_DESCRIPTION ='" & Text8.text & "' ,FONDS_CODE ='" & Text5.text & "' ,CATALOG_CODE ='" & Text6.text & "' "
strSql = strSql + ",FILE_NUMBER ='" & Text7.text & "' ,ARCHIVE_YEAR ='" & Text9.text & "' ,DATE_BEGUN ='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "' ,DATE_FINISHED ='" & Format(DTPicker3.Value, "yyyy-mm-dd") & "' "
strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS ='" & Combo1.ListIndex & "' ,RETENTION_PERIOD ='" & Combo2.ListIndex & "' ,NOTES_OF_ARCHIVIST ='" & Text11.text & "' "
strSql = strSql + ",QUANTITY =" & Text12.text & " ,MEDIUM_QUANTITY =" & Text10.text & " ,FILE_SIZE =" & Text13.text & " ,FILE_TYPE ='" & Combo3.text & "'"
strSql = strSql + ",SORT_CODE='" & Text14.text & "',SERIES_CODE='" & Text15.text & "',IS_SHARING='" & Check1.Value & "'"
strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
For listI = 1 To ListView2.ListItems.Count
listSql = "update T_ARCHIVE_0201_FILE set REFERENCE_CODE_OF_FILE_OFFICE='" & Text3.text & "',FONDS_CODE='" & Text5.text & "',CATALOG_CODE='" & Text6.text & "',FILE_NUMBER='" & Text7.text & "',sort_code='" & Text14.text & "',series_code='" & Text15.text & "' where RECORD_SEQUENCE_NUMBER=" & ListView2.ListItems(listI).SubItems(1) & ""
rs.Open listSql, conn
Next listI
End If
'MsgBox strSql
rs.Open strSql, conn
MsgBox "保存成功！", vbInformation, ""
If flag = "Insert" Then
Dim itmX As ListItem
Set itmX = form_AnJuan.ListView1.ListItems.Add(, , form_AnJuan.ListView1.ListItems.Count + 1)
itmX.SubItems(1) = num
itmX.SubItems(2) = Text3.text
itmX.SubItems(3) = Text1.text
itmX.SubItems(4) = Format(DTPicker2.Value, "yyyy-mm-dd") + " " + Format(DTPicker3.Value, "yyyy-mm-dd")
itmX.SubItems(5) = Text10.text
End If
'If flag = "Modify" Then
form_AnJuan.Refresh
'End If
Exit Sub
e:
'MsgBox Err.Number & Err.Description, vbExclamation, ""
MsgBox "请输入正确数据格式", vbExclamation, ""
If rs.State = 1 Then
rs.Close
End If
End Sub
Private Sub Command2_Click()
Unload Me
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -