f_zhuandang.frm

行政管理系统商业源码,可以down下来看看

            Begin VB.CommandButton cmdDelete 
               Caption         =   "删除"
               Height          =   300
               Left            =   2400
               TabIndex        =   7
               Top             =   0
               Width           =   1095
            End
            Begin VB.CommandButton cmdEdit 
               Caption         =   "编辑"
               Height          =   300
               Left            =   1200
               TabIndex        =   6
               Top             =   0
               Width           =   1095
            End
            Begin VB.CommandButton cmdAdd 
               Caption         =   "增加"
               Height          =   300
               Left            =   0
               TabIndex        =   5
               Top             =   0
               Width           =   1095
            End
         End
         Begin VB.Frame Frame3 
            Height          =   5775
            Left            =   -74760
            TabIndex        =   2
            Top             =   480
            Width           =   10335
            Begin MSDataGridLib.DataGrid DataGrid1 
               Height          =   5175
               Left            =   240
               TabIndex        =   3
               Top             =   360
               Width           =   9855
               _ExtentX        =   17383
               _ExtentY        =   9128
               _Version        =   393216
               AllowUpdate     =   0   'False
               HeadLines       =   1
               RowHeight       =   14
               BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
                  Name            =   "MS Sans Serif"
                  Size            =   8.25
                  Charset         =   0
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
                  Name            =   "宋体"
                  Size            =   9
                  Charset         =   134
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               ColumnCount     =   2
               BeginProperty Column00 
                  DataField       =   ""
                  Caption         =   ""
                  BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
                     Type            =   0
                     Format          =   ""
                     HaveTrueFalseNull=   0
                     FirstDayOfWeek  =   0
                     FirstWeekOfYear =   0
                     LCID            =   2052
                     SubFormatType   =   0
                  EndProperty
               EndProperty
               BeginProperty Column01 
                  DataField       =   ""
                  Caption         =   ""
                  BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
                     Type            =   0
                     Format          =   ""
                     HaveTrueFalseNull=   0
                     FirstDayOfWeek  =   0
                     FirstWeekOfYear =   0
                     LCID            =   2052
                     SubFormatType   =   0
                  EndProperty
               EndProperty
               SplitCount      =   1
               BeginProperty Split0 
                  BeginProperty Column00 
                  EndProperty
                  BeginProperty Column01 
                  EndProperty
               EndProperty
            End
         End
      End
   End
End
Attribute VB_Name = "F_ZhuanDang"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset '向档案室归档表中加入内容
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim WithEvents GuiDang_rs As Recordset '找到部门文件存档的相应内容
Attribute GuiDang_rs.VB_VarHelpID = -1
Dim WithEvents Zhuan_rs As Recordset '置部门文件存档的转档日期
Attribute Zhuan_rs.VB_VarHelpID = -1
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean




Private Sub Form_Load()
On Error Resume Next
    For Each TextBox In Me.Controls
        
        
    Next
Dim oText As TextBox

  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select  部门, 原文编号,类型,原文日期,文件名称,文件载体,存储位置,备注,类型归档代码,归档编号,归档日期,部门归档保存位置,转档日期 from 档案室归档", db, adOpenStatic, adLockOptimistic

  Set DataGrid1.DataSource = adoPrimaryRS
  
  SetButtons True

  
  
  'Bind the text boxes to the data provider
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next
  
 Set DTPicker1.DataSource = adoPrimaryRS
 Set DTPicker2.DataSource = adoPrimaryRS
 Set DTPicker3.DataSource = adoPrimaryRS
 Dim GuiDang_sql As String
GuiDang_sql = "select 归档编号 from 部门文件归档 where 是否转档 ='否'"
Set GuiDang_rs = db.Execute(GuiDang_sql)

While Not GuiDang_rs.EOF And Not IsNull(GuiDang_rs.Fields(0))
  List1.AddItem GuiDang_rs.Fields(0)
  GuiDang_rs.MoveNext
Wend

 
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr

 If Text1.Text = "" Then
    MsgBox "请在左边列表中选择一个已归档的公文编号", vbExclamation + vbOKOnly, pTitle
    Exit Sub
 End If
  
 With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
   
 End With
 
 
 If Not GuiDang_rs.EOF Then
 
    If Not IsNull(GuiDang_rs.Fields("部门")) Then
    adoPrimaryRS.Fields("部门") = GuiDang_rs.Fields("部门")
    End If
    
    
    If Not IsNull(GuiDang_rs.Fields("原文编号")) Then
    adoPrimaryRS.Fields("原文编号") = GuiDang_rs.Fields("原文编号")
    End If
     If Not IsNull(GuiDang_rs.Fields("类型")) Then
    adoPrimaryRS.Fields("类型") = GuiDang_rs.Fields("类型")
    End If
     If Not IsNull(GuiDang_rs.Fields("原文日期")) Then
    adoPrimaryRS.Fields("原文日期") = GuiDang_rs.Fields("原文日期")
    End If
     If Not IsNull(GuiDang_rs.Fields("文件名称")) Then
    adoPrimaryRS.Fields("文件名称") = GuiDang_rs.Fields("文件名称")
    End If
     If Not IsNull(GuiDang_rs.Fields("文件载体")) Then
    adoPrimaryRS.Fields("文件载体") = GuiDang_rs.Fields("文件载体")
    End If
     If Not IsNull(GuiDang_rs.Fields("备注")) Then
    adoPrimaryRS.Fields("备注") = GuiDang_rs.Fields("备注")
    End If
     If Not IsNull(GuiDang_rs.Fields("类型归档代码")) Then
    adoPrimaryRS.Fields("类型归档代码") = GuiDang_rs.Fields("类型归档代码")
     End If
     If Not IsNull(GuiDang_rs.Fields("归档编号")) Then
    adoPrimaryRS.Fields("归档编号") = GuiDang_rs.Fields("归档编号")
    End If
     If Not IsNull(GuiDang_rs.Fields("归档日期")) Then
    adoPrimaryRS.Fields("归档日期") = GuiDang_rs.Fields("归档日期")
    End If
     If Not IsNull(GuiDang_rs.Fields("部门归档保存位置")) Then
    adoPrimaryRS.Fields("部门归档保存位置") = GuiDang_rs.Fields("部门归档保存位置")
    End If
    mbAddNewFlag = True
    SetButtons False
    
    
    
   End If
  

  Exit Sub
AddErr:
  MsgBox "增加操作失败", vbExclamation + vbOKOnly, pTitle
  
End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  With adoPrimaryRS
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox "删除操作有失败", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdRefresh_Click()
  'This is only needed for multi user apps
  On Error GoTo RefreshErr
  adoPrimaryRS.Requery
  Exit Sub
RefreshErr:
   MsgBox "刷新操作有失败", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdEdit_Click()
  On Error GoTo EditErr
  mbEditFlag = True
  SetButtons False
  Exit Sub

EditErr:
   MsgBox "更改操作有失败", vbExclamation + vbOKOnly, pTitle
End Sub
Private Sub cmdCancel_Click()
 ' On Error Resume Next
 On Error GoTo CancelErr


  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate

  If mvBookMark > 0 Then
   adoPrimaryRS.Bookmark = mvBookMark
  Else
   adoPrimaryRS.MoveFirst
  End If
 SetButtons True
  Exit Sub
CancelErr:
   
   MsgBox "取消操作有失败", vbExclamation + vbOKOnly, pTitle

End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

If IsNull(DTPicker3.Value) Then
   MsgBox "请输入转档时间", vbExclamation + vbOKOnly, pTitle
   Exit Sub
End If

  adoPrimaryRS.UpdateBatch adAffectAll
zdrq = Format(DTPicker3.Value, "yyyy-mm-dd hh:mm:ss")
Dim Zhuan_Sql As String
Zhuan_Sql = "update 部门文件归档 set 是否转档 = '是',是否档案室归档 = '否',转档日期 ='" & zdrq & "' where 归档编号 ='" & Text1.Text & "'"

Set Zhuan_rs = db.Execute(Zhuan_Sql)

  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'move to the new record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True

List1.Clear
Text1.Text = ""
Dim GuiDang_sql As String
GuiDang_sql = "select 归档编号 from 部门文件归档 where 是否转档 ='否'"
Set GuiDang_rs = db.Execute(GuiDang_sql)

While Not GuiDang_rs.EOF And Not IsNull(GuiDang_rs.Fields(0))
  List1.AddItem GuiDang_rs.Fields(0)
  GuiDang_rs.MoveNext
Wend

  Exit Sub
  
  
  
UpdateErr:
   MsgBox "保存操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdClose_Click()
  WenJianGL.Enabled = True
  Unload Me
End Sub

Private Sub SetButtons(bVal As Boolean)
Dim oText As TextBox

  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  If bVal Then
   Set DataGrid1.DataSource = adoPrimaryRS
  Else
   Set DataGrid1.DataSource = Nothing
  End If
  
  For Each oText In Me.txtFields
     oText.Enabled = Not bVal
  Next
  
   DTPicker1.Enabled = Not bVal
   DTPicker2.Enabled = Not bVal
   DTPicker3.Enabled = Not bVal


 
End Sub

Private Sub List1_Click()

Text1.Text = List1.Text

End Sub

Private Sub Text1_Change()
Dim NeiRong_Sql As String
NeiRong_Sql = "select 部门,原文编号,类型,原文日期,文件名称,文件载体,备注,类型归档代码,归档编号,归档日期,部门归档保存位置,转档日期 from 部门文件归档 where  是否转档 ='否' and " & "   归档编号 = '" & Text1.Text & "'"
Set GuiDang_rs = db.Execute(NeiRong_Sql)


End Sub