form_wenshu_wj.frm

2008年版

End If
If Trim(Text20.text) = "" Then
    MsgBox "请输入科室编号!", 48
    Exit Sub
End If
If Text9.text = "" Or Text9.text = " " Then
        MsgBox "请输入责任者！", vbExclamation, ""
    Exit Sub
End If
    If Len(Text6.text) <> 4 Then
        MsgBox "年度请输入4位!", 48, ""
        Exit Sub
    End If
'归档年分位数判断,可以为空
If Me.DTPicker2.Value < Me.DTPicker1.Value Then
    MsgBox "终止时间不应小于起始时间！", 48, ""
    Exit Sub
End If
Dim sfond As Integer
    sfond = 0
    Dim sum2 As Integer
    strSql = "select count(*) from  T_ARCHIVE_FILE_VOLUME  where REFERENCE_CODE_OF_FILE_OFFICE='" + Text1.text + "'" + "  and archive_year='" & Text6.text & "' and RETENTION_PERIOD='" & Combo2.ListIndex & "'  and file_number=0"
       Debug.Print strSql
        rs.Open strSql, conn
            sum2 = rs.Fields(0).Value
            Debug.Print sum2
        rs.Close
        sfond = sum2
        If sfond > 0 Then
            If flag = "Insert" Then
               MsgBox "归档件号重复,请重输!", vbExclamation, ""
               Exit Sub
            Else
'               If Not (strfile = Text6.text + Combo2.text + Text1.text) Then
'                     MsgBox "归档件号重复,请重输!", vbExclamation, ""
'                     Exit Sub
'               End If
                strSql = "select count(*) as ff from T_ARCHIVE_FILE_VOLUME " + _
                                "where REFERENCE_CODE_OF_FILE_OFFICE='" & Text1.text & "' and RETENTION_PERIOD='" & Combo2.ListIndex & "' and ARCHIVE_YEAR='" & Text6.text & "'"
                rs.Open strSql, conn
                If rs!ff > 1 Then MsgBox "归档件号重复,请重输!", vbExclamation, "": rs.Close: Exit Sub
                rs.Close
            End If
        End If
        If Text1.text = "" Then
            MsgBox "请输入室编件号！", vbExclamation, ""
            Exit Sub
        End If
        If Text2.text = "" Then
            MsgBox "请输入题名！", vbExclamation, ""
            Exit Sub
        End If
    If flag = "Insert" Then
    
        Dim sum As Integer
        If Text4.text <> 0 And Text6.text <> "" Then
            strSql = "select count(*) from T_ARCHIVE_FILE_VOLUME where FONDS_CODE='" & Text16.text & "' and SERIES_CODE=" & Text6.text & " and FILE_NUMBER=0 "
            '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_FILE_VOLUME")
        strSql = "insert into T_ARCHIVE_FILE_VOLUME ("
        strSql = strSql + "RECORD_SEQUENCE_NUMBER,REFERENCE_CODE_OF_FILE_OFFICE,TITLE_PROPER,DOCUMENT_CODE,DATE_BEGUN,date_finished"
        strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS,RETENTION_PERIOD,ARCHIVE_YEAR"
        strSql = strSql + ",DISCRIPTOR,medium_quantity,PRIMARY_CREATOR,SUBORDINATE_CREATOR"
        strSql = strSql + ",ELECTRONIC_RECORD_CODE,VERSION,NOTES_OF_ARCHIVIST,ATTENDANT_DOCUMENT,flag"
        strSql = strSql + ",FONDS_CODE,SERIES_CODE,FILE_NUMBER"
        strSql = strSql + ",boxcode,inboxcode,office_name,IS_SHARING,office_code,office_reference_code"
        strSql = strSql + ")values("
        strSql = strSql + "" & num & ",'" & Text1.text & "','" & Text2.text & "','" & Text3.text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'"
        strSql = strSql + ",'" & Combo1.ListIndex & "','" & Combo2.ListIndex & "','" & Text6.text & "'"
        strSql = strSql + ",'" & Text7.text & "'," & Text8.text & ",'" & Text9.text & "','" & Text10.text & "' "
        strSql = strSql + ",'" & Text11.text & "','" & Combo3.text & "','" & Text13.text & "','" & Text14.text & "',1"
        strSql = strSql + ",'" & Text16.text & "'," & Text15.text & ",0"
        strSql = strSql + ",'" & Text5.text & "','" & Text19.text & "','" & Text12.text & "','" & Check1.Value & "','" & Text20.text & "','" & Text21.text & "'"
        strSql = strSql + ")"
    ElseIf flag = "Modify" Then
        strSql = "update T_ARCHIVE_FILE_VOLUME set "
        strSql = strSql + "REFERENCE_CODE_OF_FILE_OFFICE='" & Text1.text & "',TITLE_PROPER                ='" & Text2.text & "',DOCUMENT_CODE               ='" & Text3.text & "',DATE_BEGUN                  ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',date_finished='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'"
        strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS  ='" & Combo1.ListIndex & "',RETENTION_PERIOD            ='" & Combo2.ListIndex & "',ARCHIVE_YEAR                ='" & Text6.text & "'"
        strSql = strSql + ",DISCRIPTOR                  ='" & Text7.text & "',medium_quantity                 =" & Text8.text & ",PRIMARY_CREATOR             ='" & Text9.text & "',SUBORDINATE_CREATOR         ='" & Text10.text & "'"
        strSql = strSql + ",ELECTRONIC_RECORD_CODE      ='" & Text11.text & "',VERSION                     ='" & Combo3.text & "',NOTES_OF_ARCHIVIST          ='" & Text13.text & "',ATTENDANT_DOCUMENT          ='" & Text14.text & "'"
        strSql = strSql + ",boxcode='" & Text5.text & "',inboxcode='" & Text19.text & "',office_name='" & Text12.text & "',IS_SHARING='" & Check1.Value & "',office_code='" & Text20.text & "',office_reference_code='" & Text21.text & "'"
        strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
    End If
    'MsgBox strSql  boxcode为馆编档号
    rs.Open strSql, conn
    MsgBox "保存成功！", vbInformation, ""
    If flag = "Insert" Then
        Text8.text = "0"
        flagWhereF = ""
    End If
    lblState.Caption = returnInputState(Label27, Text20, Label2, Text1)
    form_WenJian.Refresh
    If flag = "Insert" Then
        Text1.text = getNextRefCode(Text6, Combo2.ListIndex, Text20)
        Text21.text = getNextOfficeRefCode(Text6, Combo2.ListIndex, Text20)
    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 DTPicker1_Change()
    DTPicker2.Value = DTPicker1.Value
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()
On Error GoTo e
    Call closeRecordSet(rs)
    backColor = bgColor
    Label1.Caption = "归档文件目录信息"
    Label1.backColor = bgColor
    
    Combo1.AddItem "公开"
    Combo1.AddItem "限制"
    Combo1.AddItem "秘密"
    Combo1.AddItem "机密"
    Combo1.ListIndex = 1
    
    Combo2.AddItem "1--永久"
    Combo2.AddItem "2--长期"
    Combo2.AddItem "3--短期"
    Combo2.ListIndex = 0
    
    Combo3.AddItem "正本"
    Combo3.AddItem "副本"
    Combo3.AddItem "草稿"
    Combo3.AddItem "定稿"
    Combo3.ListIndex = 0
    
    Text2.text = ""
    Text3.text = ""
    Text5.text = ""
    Text6.text = ""
    Text7.text = ""
    Text8.text = 0
    Text9.text = ""
    Text10.text = ""
    Text11.text = ""

    Text13.text = ""
    Text14.text = ""
    Text16 = fondsCode
    Text15 = 0
    Text4 = 0
    Text17.text = Combo2.ListIndex + 1
    Text18.text = ""
    Text19.text = ""
    Text20.text = ""
    Text21.text = ""
    DTPicker1.Value = Date
    DTPicker2.Value = Date
    Text12.text = ""
    Text12.MaxLength = 255
    
    If flag = "Modify" Then
        rs.Open "select locked from T_ARCHIVE_FILE_VOLUME where RECORD_SEQUENCE_NUMBER=" & num & "", conn
        If Not rs.EOF And Not IsNull(rs(0)) And rs(0) = 1 Then
            Text6.Locked = True
            Combo2.Locked = True
            Text20.Locked = True
        End If
        rs.Close
    End If
    
    Text1.text = getNextRefCode(Text6, Combo2.ListIndex, Text20)
    Text21.text = getNextOfficeRefCode(Text6, Combo2.ListIndex, Text20)
    Text5.text = Text1.text
    
    Text2.MaxLength = 1000
    If flag = "Modify" Then
        rs.Open "select * from T_ARCHIVE_FILE_VOLUME 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!DOCUMENT_CODE <> "" Then
            Text3.text = rs!DOCUMENT_CODE
            End If
            If rs!DATE_BEGUN <> "" And IsDate(xml("DATE_BEGUN")) Then
            DTPicker1.Value = rs!DATE_BEGUN
            End If
            If rs!DATE_FINISHED <> "" And IsDate(xml("DATE_FINISHED")) Then
            DTPicker2.Value = rs!DATE_FINISHED
            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!boxcode <> "" Then
            Text5.text = rs!boxcode
            End If
            If rs!ARCHIVE_YEAR <> "" Then
            Text6.text = rs!ARCHIVE_YEAR
            End If
            If rs!DISCRIPTOR <> "" Then
            Text7.text = rs!DISCRIPTOR
            End If
            If rs!medium_quantity <> "" Then
            Text8.text = rs!medium_quantity
            End If
            If rs!PRIMARY_CREATOR <> "" Then
            Text9.text = rs!PRIMARY_CREATOR
            End If
            If rs!SUBORDINATE_CREATOR <> "" Then
            Text10.text = rs!SUBORDINATE_CREATOR
            End If
            If rs!ELECTRONIC_RECORD_CODE <> "" Then
            Text11.text = rs!ELECTRONIC_RECORD_CODE
            End If
            If rs!Version <> "" Then
            Combo3.text = rs!Version
            End If
            If rs!NOTES_OF_ARCHIVIST <> "" Then
            Text13.text = rs!NOTES_OF_ARCHIVIST
            End If
            If rs!ATTENDANT_DOCUMENT <> "" Then
            Text14.text = rs!ATTENDANT_DOCUMENT
            End If
            Text16 = xml("FONDS_CODE")
            Text15 = xml("SERIES_CODE")
            Text17.text = Combo2.ListIndex + 1
            Text18.text = xml("boxCode")
            Text19.text = xml("inBoxCode")
            Text12.text = xml("office_name")
            If xml("IS_SHARING") <> "" Then
                Check1.Value = xml("IS_SHARING")
            End If
            Text20.text = xml("office_code")
            Text21.text = xml("office_reference_code")
        rs.Close
    End If
    Text1.MaxLength = 4
    Text2.MaxLength = 1000
    Text3.MaxLength = 50
    Text5.MaxLength = 5
    Text6.MaxLength = 4
    Text7.MaxLength = 100
    Text8.MaxLength = 5
    Text9.MaxLength = 255
    Text10.MaxLength = 255
    Text11.MaxLength = 50

    Text13.MaxLength = 1000
    Text14.MaxLength = 255
    Text19.MaxLength = 50
    strfile = Text6.text + Combo2.text + Text1.text
    Exit Sub
e:
    Call closeRecordSet(rs)
    MsgBox Err.Description
End Sub


Private Sub Text1_Change()
    Text5.text = Text1.text
End Sub

Private Sub Text20_Change()
If flag = "Insert" Then
    Text1.text = getNextRefCode(Text6, Combo2.ListIndex, Text20)
    Text21.text = getNextOfficeRefCode(Text6, Combo2.ListIndex, Text20)
End If
End Sub

Private Sub Text6_Change()
If flag = "Insert" Then
    Text1.text = getNextRefCode(Text6, Combo2.ListIndex, Text20)
    Text21.text = getNextOfficeRefCode(Text6, Combo2.ListIndex, Text20)
End If
End Sub

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

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