frmxingwen.frm

事务管理

         Top             =   1080
         Width           =   720
      End
      Begin VB.Label Label16 
         AutoSize        =   -1  'True
         Caption         =   "信件内容"
         Height          =   195
         Left            =   -74640
         TabIndex        =   52
         Top             =   1560
         Width           =   720
      End
      Begin VB.Label Label17 
         AutoSize        =   -1  'True
         Caption         =   "信件类别"
         Height          =   195
         Left            =   -67320
         TabIndex        =   51
         Top             =   600
         Width           =   720
      End
      Begin VB.Label Label18 
         AutoSize        =   -1  'True
         Caption         =   "接收人"
         Height          =   195
         Left            =   -74640
         TabIndex        =   50
         Top             =   3240
         Width           =   540
      End
      Begin VB.Label Label19 
         AutoSize        =   -1  'True
         Caption         =   "回函内容"
         Height          =   195
         Left            =   -74640
         TabIndex        =   49
         Top             =   3720
         Width           =   720
      End
      Begin VB.Label Label20 
         AutoSize        =   -1  'True
         Caption         =   "回函日期"
         Height          =   195
         Left            =   -70920
         TabIndex        =   48
         Top             =   3240
         Width           =   720
      End
      Begin VB.Label Label21 
         AutoSize        =   -1  'True
         Caption         =   "报表编号"
         Height          =   195
         Left            =   -74520
         TabIndex        =   47
         Top             =   600
         Width           =   720
      End
      Begin VB.Label Label22 
         AutoSize        =   -1  'True
         Caption         =   "发送日期"
         Height          =   195
         Left            =   -74520
         TabIndex        =   46
         Top             =   1200
         Width           =   720
      End
      Begin VB.Label Label23 
         AutoSize        =   -1  'True
         Caption         =   "保密级别"
         Height          =   195
         Left            =   -70920
         TabIndex        =   45
         Top             =   1200
         Width           =   720
      End
      Begin VB.Label Label24 
         AutoSize        =   -1  'True
         Caption         =   "传递方法"
         Height          =   195
         Left            =   -67440
         TabIndex        =   44
         Top             =   1200
         Width           =   720
      End
      Begin VB.Label Label25 
         AutoSize        =   -1  'True
         Caption         =   "标题"
         Height          =   195
         Left            =   -74520
         TabIndex        =   43
         Top             =   1800
         Width           =   360
      End
      Begin VB.Label Label26 
         AutoSize        =   -1  'True
         Caption         =   "份数"
         Height          =   195
         Left            =   -74520
         TabIndex        =   42
         Top             =   2400
         Width           =   360
      End
      Begin VB.Label Label27 
         AutoSize        =   -1  'True
         Caption         =   "接收单位"
         Height          =   195
         Left            =   -74520
         TabIndex        =   41
         Top             =   3000
         Width           =   720
      End
      Begin VB.Label Label28 
         AutoSize        =   -1  'True
         Caption         =   "接收人"
         Height          =   195
         Left            =   -74520
         TabIndex        =   40
         Top             =   3600
         Width           =   540
      End
      Begin VB.Label Label29 
         AutoSize        =   -1  'True
         Caption         =   "保存年数"
         Height          =   195
         Left            =   -74520
         TabIndex        =   39
         Top             =   4200
         Width           =   720
      End
   End
End
Attribute VB_Name = "frmwenjian"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_xingwen As New ADODB.Recordset
Dim rs_xinhan As New ADODB.Recordset
Dim rs_baobiao As New ADODB.Recordset
Dim rs_kehu As New ADODB.Recordset

Private Sub cmdadd_Click()
Dim i As Integer
On Error GoTo adderror
Frame1.Enabled = False
If cmdadd.Caption = "增加记录" Then     '当此按钮的状态为为“增加记录”时
   cmdadd.Caption = "确定"             '按钮名称改为“确定”
   cmddel.Enabled = False              '删除与修改按钮不可用
   cmdmodify.Enabled = False
   cmdcancel.Enabled = True
   Select Case SSTab1.Tab              '判断将要发生变化的是哪个tab
          Case 0
               For i = 0 To 11
                   Text1(i).Enabled = True                               '各文本框可用
                   Text1(i).Text = ""                                    '文本框内容设为空
               Next i
          Case 1
               For i = 0 To 7
                   Text2(i).Enabled = True
                   Text2(i).Text = ""
               Next i
          Case 2
               For i = 0 To 8
                   Text3(i).Enabled = True
                   Text3(i).Text = ""
               Next i
          Case 3
               For i = 0 To 7
                   Text4(i).Enabled = True
                   Text4(i).Text = ""
               Next i
   End Select
Else                                    '当按钮的状态为“确定”时
   Select Case SSTab1.Tab
          Case 0
               If Trim(Text1(0).Text) = "" Then
                  MsgBox "发文号不能为空", vbOKOnly + vbExclamation, ""
                  Text1(0).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text1(1).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入发文日期", vbOKOnly + vbExclamation, ""
                  Text1(1).SetFocus
                  Exit Sub
               End If
               If Not IsNumeric(Text1(6).Text) Then
                  MsgBox "份数请输入数字！", vbOKOnly + vbExclamation, ""
                  Text1(6).SetFocus
                  Exit Sub
               End If
               If Not IsNumeric(Text1(11).Text) Then
                  MsgBox "保存年数请输入数字！", vbOKOnly + vbExclamation, ""
                  Text1(11).SetFocus
                  Exit Sub
               End If
               Text1(1) = Format(Text1(1), "yyyy-mm-dd")     '转化为正确的格式
               rs_xingwen.AddNew
               For i = 0 To 11
                   rs_xingwen.Fields(i) = Trim(Text1(i).Text)
                   Text1(i).Enabled = False
               Next i
               rs_xingwen.Update
          Case 1
               If Trim(Text2(0).Text) = "" Then
                  MsgBox "信件号不能为空", vbOKOnly + vbExclamation, ""
                  Text2(0).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text2(1).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入信件日期", vbOKOnly + vbExclamation, ""
                  Text2(1).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text2(7).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入回函日期", vbOKOnly + vbExclamation, ""
                  Text2(7).SetFocus
                  Exit Sub
               End If
               Text2(1) = Format(Text2(1), "yyyy-mm-dd")
               Text2(7) = Format(Text2(7), "yyyy-mm-dd")
               rs_xinhan.AddNew
               For i = 0 To 7
                   rs_xinhan.Fields(i) = Trim(Text2(i).Text)
                   Text2(i).Enabled = False
               Next i
               rs_xinhan.Update
          Case 2
               If Trim(Text3(0).Text) = "" Then
                  MsgBox "报表编号不能为空！", vbOKOnly + vbExclamation, ""
                  Text3(0).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text3(1).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入发送日期", vbOKOnly + vbExclamation, ""
                  Text3(1).SetFocus
                  Exit Sub
               End If
               Text3(1) = Format(Text3(1), "yyyy-mm-dd")
               rs_baobiao.AddNew
               For i = 0 To 8
                   rs_baobiao.Fields(i) = Trim(Text3(i).Text)
                   Text3(i).Enabled = False
               Next i
               rs_baobiao.Update
          Case 3
               If Trim(Text4(0).Text) = "" Then
                  MsgBox "投诉编号不能为空", vbOKOnly + vbExclamation, ""
                  Text4(0).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text4(1).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入投诉日期", vbOKOnly + vbExclamation, ""
                  Text4(1).SetFocus
                  Exit Sub
               End If
               Text4(1) = Format(Text4(1), "yyyy-mm-dd")
               rs_kehu.AddNew
               For i = 0 To 7
                   rs_kehu.Fields(i) = Trim(Text4(i).Text)
                   Text4(i).Enabled = False
               Next i
               rs_kehu.Update
   End Select
               cmdadd.Caption = "增加记录"                             '按钮名称改为“增加记录”
               cmddel.Enabled = True                                   '删除与修改按钮可用
               cmdmodify.Enabled = True
               cmdcancel.Enabled = False
               MsgBox "增加成功", vbOKOnly + vbExclamation, ""
               Frame1.Enabled = True
End If
Exit Sub
adderror:
   MsgBox Err.Description
End Sub

Private Sub cmdcancel_Click()
Select Case SSTab1.Tab
       Case 0
            viewdata_xingwen
       Case 1
            viewdata_xinhan
       Case 2
            viewdata_baobiao
       Case 3
            viewdata_kehu
End Select
If cmdadd.Caption = "确定" Then
   cmdadd.Caption = "增加记录"
   cmdmodify.Enabled = True
   cmddel.Enabled = True
   cmdcancel.Enabled = False
ElseIf cmdmodify.Caption = "确定" Then
   cmdmodify.Caption = "修改记录"
   cmddel.Enabled = True
   cmdadd.Enabled = True
   cmdcancel.Enabled = False
End If
Frame1.Enabled = True
End Sub

Private Sub cmddel_Click()
Dim i As Integer
Dim answer As String
On Error GoTo delerror
answer = MsgBox("确定要删除吗？", vbYesNo, "")
If answer = vbYes Then
   Select Case SSTab1.Tab
          Case 0
               rs_xingwen.Delete
               rs_xingwen.MoveNext
               If rs_xingwen.EOF Then
                  rs_xingwen.MoveFirst
               End If
               viewdata_xingwen
          Case 1
               rs_xinhan.Delete
               rs_xinhan.MoveNext
               If rs_xinhan.EOF Then
                  rs_xinhan.MoveFirst
               End If
               viewdata_xinhan
          Case 2
               rs_baobiao.Delete
               rs_baobiao.MoveNext
               If rs_baobiao.EOF Then
                  rs_baobiao.MoveFirst
               End If
               viewdata_baobiao
          Case 3
               rs_kehu.Delete
               rs_kehu.MoveNext
               If rs_kehu.EOF Then
                  rs_kehu.MoveFirst
               End If
               viewdata_kehu
   End Select
   MsgBox "删除成功！", vbOKOnly + vbExclamation, ""
Else
   Exit Sub
End If
delerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdfirst_Click()
On Error GoTo firsterror
Select Case SSTab1.Tab
       Case 0
            rs_xingwen.MoveFirst
            viewdata_xingwen
       Case 1
            rs_xinhan.MoveFirst
            viewdata_xinhan
       Case 2
            rs_baobiao.MoveFirst
            viewdata_baobiao