form_shiwuv.frm

2008年版

      Height          =   180
      Left            =   3000
      TabIndex        =   31
      Top             =   6900
      Visible         =   0   'False
      Width           =   1080
   End
   Begin VB.Label Label12 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "备注"
      Height          =   180
      Left            =   540
      TabIndex        =   30
      Top             =   3735
      Width           =   360
   End
   Begin VB.Label Label11 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "著录者"
      Height          =   180
      Left            =   540
      TabIndex        =   29
      Top             =   5160
      Width           =   540
   End
   Begin VB.Label Label10 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "保管期限"
      Height          =   180
      Left            =   540
      TabIndex        =   28
      Top             =   2910
      Width           =   720
   End
   Begin VB.Label Label9 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "件数"
      Height          =   180
      Left            =   4860
      TabIndex        =   27
      Top             =   2445
      Width           =   360
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "颁发单位"
      Height          =   180
      Left            =   4860
      TabIndex        =   26
      Top             =   1980
      Width           =   720
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "电子文档号"
      Height          =   180
      Left            =   540
      TabIndex        =   25
      Top             =   4725
      Width           =   900
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "参见号"
      Height          =   180
      Left            =   540
      TabIndex        =   24
      Top             =   2420
      Width           =   540
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "颁发日期"
      Height          =   180
      Left            =   540
      TabIndex        =   23
      Top             =   1980
      Width           =   720
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "实物标题"
      ForeColor       =   &H000000C0&
      Height          =   180
      Left            =   540
      TabIndex        =   22
      Top             =   1540
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "类别"
      Height          =   180
      Left            =   540
      TabIndex        =   21
      Top             =   1100
      Width           =   360
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "室编档号"
      ForeColor       =   &H000000C0&
      Height          =   180
      Left            =   540
      TabIndex        =   20
      Top             =   660
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   18
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   2940
      TabIndex        =   19
      Top             =   120
      Width           =   1080
   End
End
Attribute VB_Name = "form_ShiWuV"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String
Private Sub Combo1_Click()
    If Combo1.ListIndex = 0 Then
        Combo1.ListIndex = 1
    End If
End Sub

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 fand("T_ARCHIVE_0204_volume", Text1.text) > 0 Then
            If flag = "Insert" Then
                MsgBox "室编档号重复,请核查!", vbExclamation, ""
                Exit Sub
            ElseIf Not (strfile = Text1.text) Then
                MsgBox "室编档号重复,请核查!", vbExclamation, ""
                Exit Sub
            End If
        End If
        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 Len(Text15.text) <> 4 Then
            MsgBox "归档年份请输入4位!", 48, ""
            Exit Sub
        End If
 '归档年分位数判断
    If flag = "Insert" Then
    flagWhere = ""
    Dim sum As Integer
        If Text6.text <> "" And Text7.text <> "" And Text8.text <> "" And Text9.text <> "0" And Text11.text <> 0 Then
        strSql = "select count(*) from T_ARCHIVE_0204_volume where FONDS_CODE='" & Text6.text & "' and class_code='" & Text7.text & "' and series_code='" & Text8.text & "'  and serial_number=" & Text9.text & " and catalog_code=" & Text11.text & " "
        'MsgBox strSql
        rs.Open strSql, conn
            sum = rs.Fields(0).Value
            Debug.Print sum
        rs.Close
        If sum > 0 Then
            MsgBox "档号重复,请核查!", vbExclamation, ""
            Exit Sub
        End If
        End If '档号重复判断
        num = id("T_ARCHIVE_0204_VOLUME")
        
        strSql = "insert into T_ARCHIVE_0204_VOLUME("
        strSql = strSql + "RECORD_SEQUENCE_NUMBER,FONDS_CODE,SERIES_CODE,FILE_NUMBER"
        strSql = strSql + ",CLASS_CODE,ITEM_CODE,SERIAL_NUMBER,TITLE_PROPER"
        strSql = strSql + ",RETENTION_PERIOD,AWARD_DATA,MEDIUM_UNIT,MEDIUM_QUANTITY"
        strSql = strSql + ",REFERENCE_CODE_OF_FILE_OFFICE,ACCOUNT_BOOK_TYPE,REFERENCED_CODE,PERSON_FOR_DESCRIPTION"
        strSql = strSql + ",DESCRIBING_DATE,NOTES_OF_ARCHIVIST,ELECTRONIC_RECORD_CODE"
        strSql = strSql + ",catalog_code"
        strSql = strSql + ",date_begun,date_finished,flag,archive_year,IS_SHARING"
        strSql = strSql + ")values("
        strSql = strSql + "" & num & ",'" & Text6.text & "','" & Text8.text & "',0"
        strSql = strSql + ",'" & Text7.text & "','" & Text10.text & "'," & Text9.text & ",'" & Text2.text & "'"
        strSql = strSql + ",'" & Combo2.ListIndex & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Text3.text & "'," & Text5.text & ""
        strSql = strSql + ",'" & Text1.text & "','" & Combo1.text & "','" & Text4.text & "','" & Text14.text & "'"
        strSql = strSql + ",'" & Format(DTPicker2.Value, "yyyy-mm-dd") & "','" & Text12.text & "','" & Text13.text & "'"
        strSql = strSql + "," & Text11.text & ""
        strSql = strSql + ",'" & Format(DTPicker3.Value, "yyyy-mm-dd") & "','" & Format(DTPicker4.Value, "yyyy-mm-dd") & "',0,'" & Text15.text & "','" & Check1.Value & "'"
        strSql = strSql + ")"
    ElseIf flag = "Modify" Then
        strSql = "update T_ARCHIVE_0204_VOLUME set "
        strSql = strSql + "FONDS_CODE                   ='" & Text6.text & "',SERIES_CODE                  ='" & Text8.text & "',CLASS_CODE                   ='" & Text7.text & "',ITEM_CODE                    ='" & Text10.text & "'"
        strSql = strSql + ",SERIAL_NUMBER                =" & Text9.text & ",TITLE_PROPER                 ='" & Text2.text & "',RETENTION_PERIOD             ='" & Combo2.ListIndex & "',AWARD_DATA                   ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "'"
        strSql = strSql + ",MEDIUM_UNIT                  ='" & Text3.text & "',MEDIUM_QUANTITY              =" & Text5.text & ",REFERENCE_CODE_OF_FILE_OFFICE='" & Text1.text & "',ACCOUNT_BOOK_TYPE            ='" & Combo1.text & "'"
        strSql = strSql + ",REFERENCED_CODE              ='" & Text4.text & "',PERSON_FOR_DESCRIPTION       ='" & Text14.text & "',DESCRIBING_DATE              ='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "',NOTES_OF_ARCHIVIST           ='" & Text12.text & "'"
        strSql = strSql + ",ELECTRONIC_RECORD_CODE       ='" & Text13.text & "',date_begun                   ='" & Format(DTPicker3.Value, "yyyy-mm-dd") & "',date_finished                ='" & Format(DTPicker4.Value, "yyyy-mm-dd") & "'"
        strSql = strSql + ",catalog_code=" & Text11.text & ",archive_year='" & Text15.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.ListView1.ListItems.Add(, , form_AnJuan.ListView1.ListItems.Count + 1)
        itmX.SubItems(1) = num
        itmX.SubItems(2) = Text1.text
        itmX.SubItems(3) = Text2.text
        itmX.SubItems(4) = Format(DTPicker1.Value, "yyyy-mm-dd")
        itmX.SubItems(5) = Text5.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
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()
    Label1.Caption = form_AnJuan.Label4.Caption + "目录信息"
    Label1.BackColor = bgColor
    
    Combo2.AddItem "永久"
    Combo2.AddItem "长期"
    Combo2.AddItem "短期"
    Combo2.ListIndex = 0
    
    Combo1.AddItem ""
    Combo1.AddItem "奖状"
    Combo1.AddItem "证书"
    Combo1.AddItem "奖杯"
    Combo1.AddItem "锦旗"
    Combo1.AddItem "铜牌"
    Combo1.AddItem "字画"
    Combo1.AddItem "其他"
    Combo1.ListIndex = 0
    
    Text1.text = ""
    Text2.text = ""
    Text3.text = ""
    Text4.text = ""
    Text5.text = 0
    Text6.text = fondsCode
    Text7.text = ""
    Text8.text = "SW"
    Text8.Enabled = False
    Text9.text = 0
    Text10.text = "1"
    Text11.text = 0
    Text12.text = ""
    Text13.text = ""
    Text14.text = ""
    Text15.text = ""
    DTPicker1.Value = Date
    DTPicker2.Value = Date
    DTPicker3.Value = Date
    DTPicker4.Value = Date
    If flag = "Modify" Then
        rs.Open "select * from T_ARCHIVE_0204_VOLUME where RECORD_SEQUENCE_NUMBER=" & num & "", conn
            Text6.text = xml("FONDS_CODE")
            Text8.text = xml("SERIES_CODE")
            Text7.text = xml("CLASS_CODE")
            Text10.text = xml("ITEM_CODE")
            Text11.text = xml("CATALOG_CODE")
            Text9.text = xml("SERIAL_NUMBER")
            Text2.text = xml("TITLE_PROPER")
            Combo2.ListIndex = xml("RETENTION_PERIOD")
            DTPicker1.Value = xml("AWARD_DATA")
            Text3.text = xml("MEDIUM_UNIT")
            Text5.text = xml("MEDIUM_QUANTITY")
            Text1.text = xml("REFERENCE_CODE_OF_FILE_OFFICE")
            Combo1.text = xml("ACCOUNT_BOOK_TYPE")
            Text4.text = xml("REFERENCED_CODE")
            Text14.text = xml("PERSON_FOR_DESCRIPTION")
            DTPicker2.Value = xml("DESCRIBING_DATE")
            Text12.text = xml("NOTES_OF_ARCHIVIST")
            Text13.text = xml("ELECTRONIC_RECORD_CODE")
            Text15.text = xml("archive_year")
            DTPicker3.Value = xml("date_begun")
            DTPicker4.Value = xml("date_finished")
            If xml("IS_SHARING") <> "" Then
                Check1.Value = xml("IS_SHARING")
            End If
        rs.Close
    End If
    strfile = Text1.text
End Sub

Private Sub Text15_KeyPress(KeyAscii As Integer)
    If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
        KeyAscii = 0
        MsgBox "请输入数字!", 48, ""
    End If
End Sub