📄 form_mediaf.frm
字号:
Caption = "保管期限"
Height = 180
Left = 750
TabIndex = 8
Top = 3926
Width = 720
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "载体数量"
Height = 180
Left = 750
TabIndex = 7
Top = 1866
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "摄录时间"
Height = 180
Left = 4650
TabIndex = 6
Top = 2280
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "主题词"
Height = 180
Left = 750
TabIndex = 5
Top = 4338
Width = 540
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "摄录地点"
Height = 180
Left = 750
TabIndex = 4
Top = 2690
Width = 720
End
Begin VB.Label Label14
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "载体类型"
Height = 180
Left = 4650
TabIndex = 3
Top = 1845
Visible = 0 'False
Width = 720
End
Begin VB.Label Label15
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "摄录者"
Height = 180
Left = 750
TabIndex = 2
Top = 2278
Width = 540
End
Begin VB.Label Label16
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文字说明"
Height = 180
Left = 720
TabIndex = 1
Top = 5700
Width = 720
End
Begin VB.Label Label18
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "参见号"
Height = 180
Left = 750
TabIndex = 0
Top = 1454
Width = 540
End
End
Attribute VB_Name = "form_MediaF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String
Dim strpage 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 Combo3_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Command1_Click()
On Error GoTo e:
If flag = "Insert" Then
' MsgBox flag
If Text1.text = "" Or Text1.text = " " Then
MsgBox "请输入室编档号！", vbExclamation, ""
Exit Sub
End If
If Text2.text = "" Or Text2.text = " " Then
MsgBox "请输入题名！", vbExclamation, ""
Exit Sub
End If
'MsgBox (form_AnJuan.List1.ListIndex)
' If fondMedia("T_ARCHIVE_0201_FILE", Text1.Text, Text6.Text, form_AnJuan.List1.ListIndex) > 0 Then
' MsgBox "在室编档号重复的情况下,件号不可重复，请核查!", vbExclamation, ""
' Exit Sub
' End If
If fandsss("T_ARCHIVE_0201_FILE", Text1.text, Text6.text) > 0 Then
If flag = "Insert" Then
MsgBox "在室编档号重复的情况下,参见号不可重复，请核查!", vbExclamation, ""
Exit Sub
ElseIf Not (strfile = Text1.text + Text6.text) Then
MsgBox "在室编档号重复的情况下,参见号不可重复，请核查!", vbExclamation, ""
Exit Sub
End If
End If
If Text7.text = "" Or Text7.text = " " Then
MsgBox "请输入责任者！", vbExclamation, ""
Exit Sub
End If
num = id("T_ARCHIVE_0201_FILE")
strSql = "insert into T_ARCHIVE_0201_FILE ("
strSql = strSql + "RECORD_SEQUENCE_NUMBER,REFERENCE_CODE_OF_FILE_OFFICE,TITLE_PROPER,SECRET_LEVEL_FOR_DOCUMENTS,RETENTION_PERIOD"
strSql = strSql + ",DISCRIPTOR,REFERENCED_CODE,PRIMARY_CREATOR,SUBORDINATE_CREATOR"
strSql = strSql + ",MEDIUM_QUANTITY,FILE_MEDIUM,TAKE_VIDEO_PERSON,DATE_BEGUN"
strSql = strSql + ",LOCATION,QUANTITY,FILE_SIZE,FILE_TYPE"
strSql = strSql + ",NOTES_OF_ARCHIVIST,REMARK"
strSql = strSql + ",flag,CLASS_CODE,IS_SHARING"
strSql = strSql + ")values("
strSql = strSql + "" & num & ",'" & Text1.text & "','" & Text2.text & "','" & Combo1.ListIndex & "','" & Combo2.ListIndex & "'"
strSql = strSql + ",'" & Text5.text & "','" & Text6.text & "','" & Text7.text & "','" & Text8.text & "'," & Text9.text & ""
strSql = strSql + ",'" & Text4.text & "','" & Text11.text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Text12.text & "'," & Text10.text & ""
strSql = strSql + "," & Text15.text & ",'" & Combo3.text & "','" & Text13.text & "','" & Text14.text & "'"
strSql = strSql + ",0,'" & form_AnJuan.List1.ListIndex & "','" & Check1.Value & "'"
strSql = strSql + ")"
ElseIf flag = "Modify" Then
If Text1.text = "" Or Text1.text = " " Then
MsgBox "请输入室编档号！", vbExclamation, ""
Exit Sub
End If
If Text2.text = "" Or Text2.text = " " Then
MsgBox "请输入题名！", vbExclamation, ""
Exit Sub
End If
If fondMedia("T_ARCHIVE_0201_FILE", Text1.text, Text6.text, form_AnJuan.List1.ListIndex) > 0 Then
If Not (strpage = Text6Text And strfile = Text1.text) Then
MsgBox "在室编档号重复的情况下,件号不可重复，请核查!", vbExclamation, ""
Exit Sub
End If
End If
strSql = "update T_ARCHIVE_0201_file set "
strSql = strSql + "REFERENCE_CODE_OF_FILE_OFFICE ='" & Text1.text & "',TITLE_PROPER ='" & Text2.text & "',SECRET_LEVEL_FOR_DOCUMENTS ='" & Combo1.ListIndex & "',RETENTION_PERIOD ='" & Combo2.ListIndex & "'"
strSql = strSql + ",DISCRIPTOR ='" & Text5.text & "',REFERENCED_CODE ='" & Text6.text & "',PRIMARY_CREATOR ='" & Text7.text & "',SUBORDINATE_CREATOR ='" & Text8.text & "' "
strSql = strSql + ",MEDIUM_QUANTITY =" & Text9.text & " ,FILE_MEDIUM ='" & Text4.text & "',TAKE_VIDEO_PERSON ='" & Text11.text & "',DATE_BEGUN ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' "
strSql = strSql + ",LOCATION ='" & Text12.text & "',QUANTITY =" & Text10.text & " ,FILE_SIZE =" & Text15.text & " ,FILE_TYPE ='" & Combo3.text & "' ,NOTES_OF_ARCHIVIST ='" & Text13.text & "',REMARK ='" & Text14.text & "',IS_SHARING='" & Check1.Value & "' "
strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
End If
'MsgBox strSql
rs.Open strSql, conn
MsgBox "保存成功！", vbInformation, ""
If flag = "Insert" Then
Dim itmX As ListItem
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , form_AnJuan.ListView2.ListItems.Count + 1)
itmX.SubItems(1) = num
itmX.SubItems(2) = Text1.text
itmX.SubItems(3) = Text2.text
itmX.SubItems(4) = Text7.text
itmX.SubItems(5) = Format(DTPicker1.Value, "yyyy-mm-dd")
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
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
backColor = bgColor
Label1.Caption = form_AnJuan.List1.text + "卷内文件信息"
Label1.backColor = bgColor
Combo1.AddItem "公开"
Combo1.AddItem "限制"
Combo1.AddItem "秘密"
Combo1.AddItem "机密"
Combo1.ListIndex = 1
Combo2.AddItem "永久"
Combo2.AddItem "长期"
Combo2.AddItem "短期"
Combo2.ListIndex = 0
Combo3.AddItem "AVI"
Combo3.AddItem "MPEG"
Combo3.AddItem "RM"
Combo3.AddItem "WAV"
Combo3.ListIndex = 0
Text1.text = ""
Text2.text = ""
Text4.text = ""
Text5.text = ""
Text6.text = ""
Text7.text = ""
Text8.text = ""
Text9.text = 0
Text10.text = 0
Text11.text = ""
Text12.text = ""
Text13.text = ""
Text14.text = ""
Text15.text = 0
DTPicker1.Value = Date
Text1.MaxLength = 24
Text2.MaxLength = 1000
Text4.MaxLength = 20
Text5.MaxLength = 100
Text6.MaxLength = 128
Text7.MaxLength = 255
Text8.MaxLength = 255
Text9.MaxLength = 4
Text10.MaxLength = 6
Text11.MaxLength = 60
Text12.MaxLength = 100
Text13.MaxLength = 1000
Text14.MaxLength = 1000
Text15.MaxLength = 10
If flag = "Modify" Then
rs.Open "select * from T_ARCHIVE_0201_FILE where RECORD_SEQUENCE_NUMBER=" & num & "", conn
If rs!REFERENCE_CODE_OF_FILE_OFFICE <> "" Then
Text1.text = rs!REFERENCE_CODE_OF_FILE_OFFICE
End If
If rs!TITLE_PROPER <> "" Then
Text2.text = rs!TITLE_PROPER
End If
If rs!SECRET_LEVEL_FOR_DOCUMENTS <> "" Then
Combo1.ListIndex = rs!SECRET_LEVEL_FOR_DOCUMENTS
End If
If rs!RETENTION_PERIOD <> "" Then
Combo2.ListIndex = rs!RETENTION_PERIOD
End If
If rs!DISCRIPTOR <> "" Then
Text5.text = rs!DISCRIPTOR
End If
If rs!REFERENCED_CODE <> "" Then
Text6.text = rs!REFERENCED_CODE
End If
If rs!PRIMARY_CREATOR <> "" Then
Text7.text = rs!PRIMARY_CREATOR
End If
If rs!SUBORDINATE_CREATOR <> "" Then
Text8.text = rs!SUBORDINATE_CREATOR
End If
If rs!medium_quantity <> "" Then
Text9.text = rs!medium_quantity
End If
If rs!file_MEDIUM <> "" Then
Text4.text = rs!file_MEDIUM
End If
If rs!TAKE_VIDEO_PERSON <> "" Then
Text11.text = rs!TAKE_VIDEO_PERSON
End If
If rs!DATE_BEGUN <> "" Then
DTPicker1.Value = rs!DATE_BEGUN
End If
If rs!Location <> "" Then
Text12.text = rs!Location
End If
If rs!QUANTITY <> "" Then
Text10.text = rs!QUANTITY
End If
If rs!FILE_SIZE <> "" Then
Text15.text = rs!FILE_SIZE
End If
If rs!FILE_TYPE <> "" Then
Combo3.text = rs!FILE_TYPE
End If
If rs!NOTES_OF_ARCHIVIST <> "" Then
Text13.text = rs!NOTES_OF_ARCHIVIST
End If
If rs!REMARK <> "" Then
Text14.text = rs!REMARK
End If
If xml("IS_SHARING") <> "" Then
Check1.Value = xml("IS_SHARING")
End If
rs.Close
End If
strfile = Text1.text + Text6.text
'MsgBox "mediaform"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -