Visual Basic 管理信息开发案例 第1 4章 第3章 办公文档管理信息系统课件.ppt

第3章 办公文档管理信息系统,3.1 系统开发的功能分析 3.2 设计好自己的数据库 3.3 系统开发过程的实现 3.4 应用程序的打包和发布 3.5 相关开发技术介绍 3.6 最终运行结果的查看,在线教务辅导网：http:/,教材其余课件及动画素材请查阅在线教务辅导网,QQ:349134187 或者直接输入下面地址：,http:/,3.1 系统开发的功能分析,3.1.1 设计目标 本章要开发的办公文档管理信息系统是用来实现对日常办公中产生的电子文档的存储、备案、检索等信息处理功能。其总体设计目标是实现办公电子文档管理的系统化和自动化，帮助企业工作人员更好、更高效地完成电子信息资料的管理工作。,3.1.2 需要实现的系统功能 我们知道，现在多数企业、单位，无论其规模大小，大都有自己的数据库来实现对自己企业内部信息的管理。本办公文档管理信息系统的开发，正是要设计这样一个用来对数据进行处理，对日常电子文档信息进行管理的软件系统来满足人们的实际需求。,确定了本系统的设计目标之后，在开发本系统时需要实现的系统功能主要有如下所述几点： (1) 对个人电脑中的各种电子文档进行编目，并能够根据自己的需要建立文档索引信息，便于以后进行查询。 (2) 将各种电子文档存储到数据库中，而不是存入磁盘目录，从而有效地防止误删除或硬盘故障导致数据无法恢复。,(3) 能够自动按照编目类别来显示查询已存储过的电子文档，并支持各种Windows常用格式，如Office、IE、图形和多媒体文件。 (4) 所有信息保存在单一的数据库文件中，保存了数据库文件，则就可以保存所有文档。,3.1.3 开发和运行环境 开发工具：Visual Basic 6.0，所用后台数据库是Access 2000。 运行环境：Windows 9x、Windows NT、Windows 2000或Windows XP/2003操作系统。,3.1.4 系统功能模块的设计 根据日常工作中的实际需求，本系统在设计中充分利用了数据库技术和文件处理技术来实现对文档进行管理和维护，同时还提供了一些常用的办公管理功能，以丰富该系统的“个人”特性。 1个人文档管理功能 强大的文档管理功能使用户可以用该软件快速地查阅出所需的文件，并顺利将其归入预先设定好的档案目录中。,2个人日常管理功能 可以将每次会议的时间、会议纪要以及其他信息登记到时间记录器上，它会定时提醒您所要做的事情，同时还可以定期将此信息进行整理，帮助您对日常繁杂的工作进行管理。 3方便的阅读和检索功能 可以像阅读一本书一样快速翻阅、保存各类文档，并且可以将保存的文档按照原有的格式存为文件。,4个人通讯管理功能 可用软件中的名片夹将所有名片按一定顺序记录，使用户可以随时翻阅、记录信息，并自动进行保存。 5自动归档功能 可按用户所选择的目录以及安排的自动保存时间，无须人工干预，自动检索文件并存入数据库，让工作更轻松、周密。,6定时提醒 可将自己的用户、朋友等个人信息存入数据库，并随意安排自己的时间，系统将会按照你的安排定时对你发出提醒信息。 7支持多种文件格式 能够分类保存给予Windows的各种格式的文档，包括Word、Excel、PowerPoint以及各种图文图像、语音软件等。 本系统的总体功能结构图如图3-1-1所示。,图3-1-1 本系统的总体功能结构图,3.2 设计好自己的数据库,本系统所使用的一些Access格式等数据库表格结构，各表格的名称、数据项及类型在以下表格中有明确说明，读者完全可以按照这些说明来使用Access设计表格。 (1) 文档信息表，如表3-2-1所示。 (2) 联系人表，如表3-2-2所示。 (3) 个人信息表，如表3-2-3所示。,表3-2-1 文档信息表,表3-2-2 联系人表,表3-2-3 个人信息表,(4) 约会会议表，如表3-2-4所示。(5) 项目表，如表3-2-5所示。 (6) 自动归档表，如表3-2-6所示。(7) 重要信息表，如表3-2-7所示。,表3-2-4 约会会议表,表3-2-5 项目表,表3-2-6 自动归档表,表3-2-7 重要信息表,3.3 系统开发过程的实现,本书中所涉及到的每一个模块的开发，均是按照创建应用程序界面设置属性编写代码这个思路来介绍给读者的。下面就来创建第一个窗体界面。界面的设计有两步：先绘制控件，然后确定控件属性。本系统包含的程序文件如表3-3-1所示。,表3-3-1 程序文件列表,3.3.1 程序模块的调用关系 在该系统中各种窗体和程序中模块的调用关系如表3-3-2所示，读者可以根据该表格对照提供的源程序来掌握程序设计的内容。,表3-3-2 窗体和模块的调用关系,3.3.2 创建公用代码模块module1.bas 所创建的公用代码模块module1.bas部分用来实现对系统公用代码、函数的编写，同时，将启动程序函数Main设计出来。在该代码模块中，主要用来进行变量定义、函数定义和启动程序调用。,通常设置启动窗体的方法如下： (1) 在缺省情况下，应用程序中的第一个窗体被指定为启动窗体。如果想在应用程序启动时显示别的窗体，那么就得改变启动窗体。 (2) 如果想要应用程序在启动时不加载任何窗体，例如，可能想先运行装入数据文件的代码，然后再根据数据文件的内容决定显示几个不同窗体中的其中一个，就可以在标准模块中创建一个名为Main的子过程，如本例中的标准模块中的SubMain子过程。,Main过程必须是一个子过程，且不能在窗体模块内。要想将Sub Main过程设为启动对象，可从菜单中选取【工程】【工程属性】命令选项，再选【通用】选项卡，然后从【启动对象】框中选定“Sub Main”，如图3-3-1所示。,图3-3-1 从【启动对象】框中选定“Sub Main”,(3) 如果在启动时有一个较长的执行过程，例如要从数据库中装入大量数据或者要装入一些大型位图，这时就可能希望在启动时能够给出一个快速显示。快速显示是一种窗体，它通常显示的是诸如应用程序名、版权信息和一个简单的位图等内容。,其实在启动Visual Basic时所显示的屏幕就是一个快速显示。要实现快速显示，需用Sub Main过程作为启动对象，并用Show方法来显示该窗体，设计代码如下： Sub Main( ) 显示快速显示 frmSplash.Show frmMain.Show Unload frmSplash End Sub,3.3.3 实现程序主窗体frmMain的设计 主程序frmMain窗体是首先出现的系统操作界面，也是整个系统的主要操作界面，如图3-3-2所示，该程序由Sub Main函数调用。在运行程序以前，需要先设置好ODBC数据源。在这里将该数据源的名字保存为DM，使用的数据库是Access格式的DM.mdb数据库。,本程序所要实现的主要功能如下： (1) 实现对整个系统子程序的调用，同时能够将系统中的常用信息显示出来。 (2) 能够自动显示日期和相关项目信息，并能够同时提供警告，通过项目信息类别的颜色来处理。 (3) 能够提供工具菜单中的多种操作，让用户可以方便地根据自身的需要来选择辅助功能。,图3-3-2 系统主界面,另外，在窗体中还特意设置了一些辅助菜单，这些菜单用来调用一些常用的功能。 为窗体中的控件添加的设计代码如下： Private Declare Function SendMessage Lib user32 Alias SendMessageA (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Const EM_UNDO = &HC7,Private Declare Function OSWinHelp% Lib user32 Alias WinHelpA (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)Dim DraggedDate As DatePublic AutoSaveTime As DatePublic cn As New ADODB.Connection,下面的代码用来实现处理ListView中的信息，当选择一个文件时，进行对应的处理。具体设计代码如下： Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem) If Not (Me.ActiveForm Is Nothing) Then Unload Me.ActiveForm End If Select Case Item.Text Case 文档归档,mnuToolsDocuments_Click Case 文档阅读 mnuToolsRead_Click Case 项目信息 mnuToolsProject_Click Case 我的约会 mnuToolsAppointment_Click Case 我的名片 mnuToolsContact_Click Case Else End SelectEnd Sub,接下来是程序初始化的调用模块，该模块可以通过数据环境来显示文件的信息情况。具体设计代码如下： Private Sub MDIForm_Load( ) Me.Left = GetSetting(App.Title, Settings, MainLeft, 1000) Me.Top = GetSetting(App.Title, Settings, MainTop, 1000) Me.Width = GetSetting(App.Title, Settings, MainWidth, 6500) Me.Height = GetSetting(App.Title, Settings, MainHeight, 6500),MonthView1.Value = Date Call EverydayTips DEDocuments.rs自动归档表.Open AutoSaveTime = DEDocuments.rs自动归档表.Fields(最后归档时间) Picture1.AutoSize = False Picture1.Align = vbAlignLeft Picture1.Width = Me.Width / 7 Picture2.AutoSize = False Picture2.Align = vbAlignLeft Picture2.Width = Me.Width * 6 / 7,ListView1.ColumnHeaders.Clear ListView1.ListItems.Clear ListView1.View = lvwIcon ListView1.Font.Name = 宋体 ListView1.Font.Size = 9 ListView1.Height = Picture1.Height ListView1.Width = Picture1.Width ListView1.BackColor = Picture1.BackColor ListView1.ListItems.Add , , 文档归档, 1 ListView1.ListItems.Add , , 文档阅读, 1 ListView1.ListItems.Add , , 我的约会, 1,ListView1.ListItems.Add , , 我的名片, 1 ListView1.ListItems.Add , , 项目信息, 1 tvwCRefreshEnd Sub,要想系统能够实现每日提醒功能，就需要使当系统时间到达提醒时间的时候，能够自动查询数据库中的相关内容，并显示符合条件的记录提醒文字信息。具体设计代码如下： Private Sub EverydayTips( ) Dim td As Variant Dim tips As String tips = “今天是：” DEDocuments.rs重要信息表.Open,If DEDocuments.rs重要信息表.EOF Then tips = 您应该考虑备份的日子了， Else,tips = 您应该考虑备份的日子了。另外， Do While Not DEDocuments.rs重要信息表.EOF td = DEDocuments.rs重要信息表.Fields(日期).Value If Month(td) = Month(Date) And Day(td) = Day(Date) Then tips = tips & DEDocuments.rs重要信息表.Fields(类别).Value & ； tips = tips & DEDocuments.rs重要信息表.Fields(说明).Value End If DEDocuments.rs重要信息表.MoveNext Loop End If tips = tips & 您可要重视啊！不要忘记哦！ sbStatusBar(0).Panels(1).Text = tipsEnd Sub,然后就是初始化程序启动的参数和内容了。具体设计代码如下：Private Sub MDIForm_Unload(Cancel As Integer) If Me.WindowState vbMinimized Then SaveSetting App.Title, Settings, MainLeft, Me.Left SaveSetting App.Title, Settings, MainTop, Me.Top SaveSetting App.Title, Settings, MainWidth, Me.Width SaveSetting App.Title, Settings, MainHeight, Me.Height End IfEnd Sub,Private Sub mnuEditCancel_Click( ) SendKeys ZEnd SubPrivate Sub mnuEditRefresh_Click( ) If Me.ActiveControl Is Picture1 Then Me.MSHFlexGrid1.Refresh Me.tvwC.Refresh End IfEnd Sub,Private Sub mnuToolsAppointment_Click( ) Dim f As New frmAppointment Me.Picture2.Visible = False f.ShowEnd SubPrivate Sub mnuToolsContact_Click() Dim f As New frmContact Me.Picture2.Visible = False f.ShowEnd Sub,Private Sub mnuToolsDiskSpace_Click( ) MsgBox FreeSpace( )End SubPrivate Sub mnuToolsDocuments_Click( ) Dim f As New frmDocuments Me.Picture2.Visible = False f.ShowEnd Sub,Private Sub mnuToolsMsg_Click( ) MessengerOrig.Show (1)End SubPrivate Sub mnuToolsProject_Click( ) Dim f As New frmProject Me.Picture2.Visible = False f.ShowEnd Sub,Private Sub mnuToolsRead_Click( ) Me.Picture2.Visible = False frmRead.Adodc1.ConnectionString = DSN=DM;UID=;PWD=; frmRead.ShowEnd SubPrivate Sub mnuToolsReports_Click( ) frmReports.ShowEnd Sub,Private Sub MonthView1_DateDblClick(ByVal DateDblClicked As Date) Dim f As New frmAppointment Load f f.txtFields(3).Text = DateDblClicked Me.Picture2.Visible = False f.ShowEnd SubPrivate Sub mnuToolsOptions_Click( ) frmOptions.Show vbModal, MeEnd Sub,下面的代码用来实现文件的另存为功能，使其能够将数据库中的OLE文件内容保存为磁盘文件，以便以后使用相应的工具来打开，具体设计代码如下： Private Sub mnuFileSaveAs_Click( ) Dim sFile As String If TypeOf ActiveForm Is frmDocuments Then With dlgCommonDialog .DialogTitle = 另存为 .CancelError = False,ToDo: 设置 Common Dialog 控件的标志和属性 .Filter = 所有文件 (*.*)|*.* .ShowSave If Len(.FileName) = 0 Then Exit Sub End If sFile = .FileName End With ActiveForm.Caption = sFile ActiveForm.rtfText.SaveFile sFile frmDocuments.OLE1.SaveToFile dlgCommonDialog.FileName SaveSetting wlf, DM, date, Date End IfEnd Sub,Private Sub mnuFileSave_Click( ) Dim sFile As String If TypeOf Me.ActiveForm Is frmDocuments Then With dlgCommonDialog .DialogTitle = 保存 .CancelError = False ToDo: 设置Common Dialog 控件的标志和属性 .Filter = 所有文件 (*.*)|*.* .ShowSave If Len(.FileName) = 0 Then Exit Sub End If,sFile = .FileName End With frmDocuments.OLE1.SaveToFile dlgCommonDialog.FileName SaveSetting wlf, DM, date, Date End IfEnd SubPrivate Sub mnuFileClose_Click( ) If Not ActiveForm Is Nothing Then Unload Me.ActiveForm Picture2.Visible = True End IfEnd Sub,Private Sub Timer1_Timer( ) If Time = AutoSaveTime Then AutoSave End IfEnd Sub,下面的函数用来对自动归档功能进行处理。需要提醒大家的一点是：该函数不但使用了数据环境对象，而且还同时使用了系统文件处理的脚本对象，因此就要求大家设计时在工程中引用Scripting对象。,具体的设计代码如下：Public Function AutoSave( ) Dim FSO As New Scripting.FileSystemObject Dim fil As Scripting.File Dim bDate, eDate, fDate As Date Dim oldFolder As String Dim lngOffset As Long Dim lngLogoSize As Long Dim varLogo As Variant Dim varChunk As Variant Const conChunkSize = 100,Data1.RecordSource = 自动归档表 Data1.DefaultType = 1 Data1.Refresh Data1.Recordset.MoveFirst,以下使用数据环境对象进行数据处理的方法和使用ADO控件处理数据的方法基本相同，只不过是换了一种技术方式而已。当然，数据环境还有其他重要功能，在以后的章节中我们将对其进行详细介绍。,具体的设计代码如下： oldFolder = DEDocuments.rs自动归档表.Fields(原磁盘位置) If oldFolder = Then Exit Function End If bDate = DEDocuments.rs自动归档表.Fields(建立开始日期) eDate = DEDocuments.rs自动归档表.Fields(“建立结束日期”) For Each fil In FSO.GetFolder(oldFolder).Files,If fil.DateLastModified = bDate And fil.DateLastModified = eDate Then DEDocuments.rs文档信息表.AddNew DEDocuments.rs文档信息表.Fields(标题) = DEDocuments.rs自动归档表.Fields(标题) DEDocuments.rs文档信息表.Fields(主题) = DEDocuments.rs自动归档表.Fields(主题) DEDocuments.rs文档信息表.Fields(作者) = DEDocuments.rs自动归档表.Fields(作者),DEDocuments.rs文档信息表.Fields(单位) = DEDocuments.rs自动归档表.Fields(单位) DEDocuments.rs文档信息表.Fields(类别) = DEDocuments.rs自动归档表.Fields(类别) DEDocuments.rs文档信息表.Fields(关键词) = DEDocuments.rs自动归档表.Fields(关键词) DEDocuments.rs文档信息表.Fields(内容简介) = DEDocuments.rs自动归档表.Fields(内容简介) DEDocuments.rs文档信息表.Fields(原磁盘位置) = fil.ParentFolder & & fil.Name,DEDocuments.rs文档信息表.Fields(完成日期) = fil.DateLastModified DEDocuments.rs文档信息表.Fields(版本号) = DEDocuments.rs自动归档表.Fields(版本号) DEDocuments.rs文档信息表.Fields(语言) = DEDocuments.rs自动归档表.Fields(语言) DEDocuments.rs文档信息表.Fields(编写目的) = DEDocuments.rs自动归档表.Fields(编写目的) DEDocuments.rs文档信息表.Fields(最后归档时间) = Now DEDocuments.rs文档信息表.Fields(使用频率) = DEDocuments.rs自动归档表.Fields(使用频率),DEDocuments.rs文档信息表.Fields(重要程度) = DEDocuments.rs自动归档表.Fields(重要程度) DEDocuments.rs文档信息表.Fields(文件格式) = fil.Type OLE1.CreateEmbed fil.ParentFolder & & fil.Name OLE1.Update Data1.UpdateRecord DEDocuments.rs自动归档表.MoveFirst lngLogoSize = DEDocuments.rs自动归档表.Fields(内容).ActualSize,Do While lngOffset lngLogoSize varChunk = DEDocuments.rs自动归档表.Fields(内容).GetChunk(conChunkSize) varLogo = varLogo & varChunk lngOffset = lngOffset + conChunkSize Loop lngOffset = 0 Reset offset. Do While lngOffset lngLogoSize varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), conChunkSize),DEDocuments.rs文档信息表.Fields(内容).AppendChunk varChunk lngOffset = lngOffset + conChunkSize Loop DEDocuments.rs文档信息表.UpdateBatch adAffectAllChapters End If Next MsgBox 自动归档已经完成！, vbOKOnly, 提示！End Function,Private Sub tvwC_NodeClick(ByVal Node As MSComctlLib.Node) Label1.Caption = IIf(IsNull(Node.Tag), (该项目没有详细描述信息，请您补充。), Node.Tag)End Sub,下面的函数用来填充树状结构的控件，显示项目的相关信息。Private Sub tvwCRefresh( ) Dim rsa As New ADODB.Recordset Dim rootNode As Node, nd As Node Dim diffB, diffE As Integer On Error Resume Next cn.Open DSN=DM;UID=;PWD=;,rsa.Open 项目信息, cn, adOpenForwardOnly, adLockReadOnly If Err Then MsgBox Unable to open aaa table, vbCritical End End If Set rootNode = tvwC.Nodes.Add(, , Projects, 项目信息, 2) rootNode.Expanded = True Do Until rsa.EOF,Set nd = tvwC.Nodes.Add(rootNode.Key, tvwChild, , rsa.Fields(客户), 1) nd.Tag = rsa.Fields(客户) diffB = rsa.Fields(项目开始日期) - Date diffE = rsa.Fields(项目结束日期) - Date If diffB 0 Then nd.ForeColor = vbBlue End If If diffB 0 And diffB 30 Then nd.ForeColor = vbGreen End If,If diffE 0 Then nd.ForeColor = vbRed End If AddDummyChild nd rsa.MoveNext Loop rsa.CloseEnd Sub,Sub AddDummyChild(nd As Node) add a dummy child node, if necessary If nd.children = 0 Then dummy nodes Text property is * tvwC.Nodes.Add nd.Index, tvwChild, , * End IfEnd SubPrivate Sub tvwC_Expand(ByVal Node As MSComctlLib.Node) a node if being expanded Dim nd As Node, exit if the node had been already expanded in the past If Node.children = 0 Or Node.children 1 Then Exit Sub also exit if it doesnt have a dummy child node If Node.Child.Text * Then Exit Sub remove the dummy child item tvwC.Nodes.Remove Node.Child.Index add all the titles for this Node object AddTitles NodeEnd Sub,Private Sub AddTitles(ByVal Node As MSComctlLib.Node) Dim nd As Node Dim diff As Integer Dim rsb As New ADODB.Recordset rsb.Open select * from 项目信息 where trim(客户) = & Trim(Node.Tag) & , cn, adOpenForward Only, adLockReadOnly Do Until rsb.EOF,Set nd = tvwC.Nodes.Add(Node, tvwChild, , rsb.Fields(项目名称) & ： & FormatDateTime (rsb.Fields (项目开始日期), vbLongDate) & 至 & FormatDateTime(rsb.Fields(项目结束日期), vbLongDate), 1) diff = rsb.Fields(项目结束日期) - rsb.Fields(项目开始日期) nd.Tag = 项目情况： & vbCrLf & 工期： & Str(diff) & 天 & vbCrLf & rsb.Fields(项目说明) rsb.MoveNext Loop rsb.CloseEnd Sub,3.3.4 设计约会会议(FrmAppointment)窗体界面 本窗体界面主要用来实现系统中约会会议的管理功能，利用数据库来记录个人的日常约会和会议信息。其中使用了Visual Basic中常用的一些控件，如TabDlg.SSTabSSTab1、RichTextLib.RichTextBox RTFText、VB.CommandButton cmdAdd、cmdUpdate、cmdDelete、cmdClose、MSDataListLib.DataCombo DataCombo2、VB.Frame Frame、MSComCtl2.UpDown UpDown1、MSDataGridLib.DataGrid DataGrid1和MSAdodcLib.Adodc datPrimaryRS等。其中最为重要的是SSTab控件，这可以通过添加部件功能来增加。,如图3-3-3所示界面实现的功能如下：(1) 约会信息的录入。(2) 对所录入的信息进行基本的处理。,图3-3-3 约会会议窗体界面,本窗体界面的设计代码如下：Private Sub Form_Unload(Cancel As Integer) Screen.MousePointer = vbDefaultEnd SubPrivate Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean),错误处理程序代码置于此处 想要忽略错误，注释掉下一行 想要捕获它们，在此添加代码以处理它们 MsgBox Data error event hit err: & DescriptionEnd Sub,Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error,adStatus As ADODB.EventStatusEnum,ByVal pRecordset As ADODB.Recordset) 为这个Recordset 显示当前记录位置 datPrimaryRS.Caption = Record: & CStr(datPrimaryRS.Recordset.AbsolutePosition)End Sub,Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset) 验证代码置于此处,下列动作发生时该事件被调用 Dim bCancel As Boolean Select Case adReason Case adRsnAddNew Case adRsnClose Case adRsnDelete Case adRsnFirstChange Case adRsnMove Case adRsnRequery Case adRsnResynch Case adRsnUndoAddNew Case adRsnUndoDelete,Case adRsnUndoUpdate Case adRsnUpdate End Select If bCancel Then adStatus = adStatusCancelEnd SubPrivate Sub cmdAdd_Click( ) On Error GoTo AddErr datPrimaryRS.Recordset.AddNew,txtFields(10).Text = GetSetting(wlf, DM, UserName, Default:= ) Exit SubAddErr: MsgBox Err.DescriptionEnd SubPrivate Sub cmdDelete_Click( ) On Error GoTo DeleteErr With datPrimaryRS.Recordset .Delete,.MoveNext If .EOF Then .MoveLast End With Exit SubDeleteErr: MsgBox Err.DescriptionEnd Sub 细心的读者可能已经注意到了，在上面的代码中用到了Recordset的多种使用方法，如MoveFirst、MoveLast、Delete等，其相关知识将在后面进行介绍。,Private Sub cmdUpdate_Click( ) On Error GoTo UpdateErr datPrimaryRS.Recordset.MovePrevious datPrimaryRS.Recordset.MoveNext DataGrid1.Refresh Exit SubUpdateErr: MsgBox Err.DescriptionEnd Sub,Pr