查找文档功能的实现

编写文件单选事件，单击文件查找控件，在其单击事件中编写文件查找的语句，实现方法是提供给用户一个输入查找文件的输入框，根据输入的内容打开表进行查找，表中没有所找的文件则退出，否则把找到的文件显示在列表框中，由于列表框设置为报表类型，所以向列表框中增加项时，记录的第一个字段是主项，其它是子项，增加项时应该判断其是否为空值，且用标记设置所增加的是文件。由于全部用中文显示且数据来源于不同的表中，故必须用复合查询语句实现。代码如下：

Private Sub Option2_Click()
Dim FindKey As String
Dim strWhere As String Dim strSql As String
Dim recTemp As New ADODB.Recordset

FindKey = InputBox("请输入查询文件的关键字", "查询")

strSql = "SELECT DISTINCT A.File_name,A.File_des,_
  B.UserName,A.Create_date,A.file_id FROM doc_file A,_
  yg_tab B,doc_path C Where A.File_use = B.Userid and_
  a.keyword='" & FindKey & "'"
Set recTemp = objDB.ExecuteSQL(strSql)

If recTemp.EOF And Node.Children = 0 Then
  ListView1.ListItems.Clear
Else
   With recTemp
     If .EOF Then Exit Sub
     .MoveFirst

     Do While Not .EOF
     Set lItem = ListView1.ListItems.Add(, "K" + _
         CStr(recTemp("file_id")), recTemp(0), , "Doc")
    lItem.ListSubItems.Add , , IIf(IsNull(recTemp(1)), "", recTemp(1))
    lItem.ListSubItems.Add , , IIf(IsNull(recTemp(2)), "", recTemp(2))
    lItem.ListSubItems.Add , , IIf(IsNull(recTemp(3)), "", recTemp(3))
    lItem.Tag = "file"
   .MoveNext
   Loop
  End With

TreeView1.Visible = False

End Sub

浏览功能的实现

当用户在浏览文档时是由树结点所选择，所以我们应该编写树结点的单击事件的代码。当用户单击树结点时我们应该根据他所单击的结点确定该结点的路径并显示之，该结点下的目录和文件应该全部显示在列表框中。目录与文件用不同的图标标识。列表框的内容更新时注意先清除各项。代码如下：

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Dim strWhere As String
Dim strSql As String
Dim recTemp As New ADODB.Recordset
Dim intParID
Dim lItem As ListItem
Set CurrNode = Node

If Len(Node.FullPath) > 7 Then
  txtPath.Text = "当前浏览目录：" + Right(Node.FullPath, _
    Len(Node.FullPath) - 7)
Else
  txtPath.Text = "当前浏览目录：" + Node.FullPath
Exit Sub
End If

intParID = CInt(Mid(Node.Key, 2, Len(Node.Key)))
strWhere = "Path_Id=" & intParID & " order by id"

strSql = "SELECT DISTINCT A.Path_name, A.Path_des,B.UserName,_
   A.Dir_date FROM doc_path A ,yg_tab B _
  where A.Create_userid = B.userid and A.sub_id=" & intParID

Set recTemp = objDB.ExecuteSQL(strSql) 

If Not recTemp.EOF Then
  With recTemp
  ListView1.ListItems.Clear
  .MoveFirst
Do While Not .EOF
  Set lItem = ListView1.ListItems.Add(, , recTemp(0), , "Close")
  lItem.ListSubItems.Add , , IIf(IsNull(recTemp(1)), "", recTemp(1))
  lItem.ListSubItems.Add , , IIf(IsNull(recTemp(2)), "", recTemp(2))
  lItem.ListSubItems.Add , , IIf(IsNull(recTemp(3)), "", recTemp(3))
  lItem.Tag = "node"
  .MoveNext
Loop
End With
End If
strSql = "SELECT DISTINCT A.File_name,A.File_des,B.UserName,_
   A.Create_date,A.file_id FROM doc_file A,yg_tab B,_
   doc_path C Where A.File_use = B.Userid and a.path_id=" & intParID

Set recTemp = objDB.ExecuteSQL(strSql)

If recTemp.EOF And Node.Children = 0 Then
ListView1.ListItems.Clear
Else
With recTemp
If .EOF Then Exit Sub
.MoveFirst
Do While Not .EOF
Set lItem = ListView1.ListItems.Add(, "K" +_
    CStr(recTemp("file_id")), recTemp(0), , "Doc")
lItem.ListSubItems.Add , , IIf(IsNull(recTemp(1)), "", recTemp(1))
lItem.ListSubItems.Add , , IIf(IsNull(recTemp(2)), "", recTemp(2))
lItem.ListSubItems.Add , , IIf(IsNull(recTemp(3)), "", recTemp(3))
lItem.Tag = "file"
.MoveNext
Loop
End With
End If
End Sub

文档上载功能的实现

文档上载主要是把用户的文件保存在用户所指定的目录中，我们可以借助公共对话控件为用户提供上载界面。把公共对话控件设置为保存就可。文档上载时该先判断用户所选择的是文件，否则不能上载，且上载时应该考虑文件是否已存在。文件上载可通过建立文件系统对象Scripting.FileSystemObject，利用FileSystemObject的CopyFile方法实现。代码如下：

Private Sub cmdSave_Click()

   Dim DecFileName As String

   Dim fs

   Dim strFileName As String

   If ListView1.SelectedItem.Tag <> "file" Then

      Exit Sub

   End If 

   strFileName = App.Path + "\temp"

   dlgFileSave.ShowSave

   DecFileName = dlgFileSave.FileName

   Set fs = CreateObject("Scripting.FileSystemObject")

   If fs.FileExists(DecFileName) Then

   If MsgBox("文件已存在，是否覆盖？", vbQuestion + vbYesNo, "提示") = vbNo Then

          Exit Sub

    End If

    End If

  dlgFileSave.Flags = cdlOFNOverwritePromptfile2

  If DecFileName <> "" Then

     fs.CopyFile strFileName, DecFileName

  End If

  cmdSave.Enabled = False

End Sub

增加目录功能的实现

增加目录是根据用户的需要，由用户创建，其内容由用户录入。我们提供一个录入界面，把输入的信息保存在目录表中。

实现方法是增加一个表单，命名为frmCreateDir。在上面放入四个标签控件，三个文本控件并命名为txtDirName、txtPath、txtDes，一个下拉列表控件并命名为cboType。二个按钮并命名为cmdYes、cmdCance如下图：

单击确定按钮，在其单击事件中编写代码。先判断输入是否有效，数据有效r后打开表，把数据插入表中。同时注意要更新树视图。

Private Sub cmdYes_Click()

  Dim recTemp As New ADODB.Recordset

   If txtDirName = "" Then

      MsgBox "请输入目录名称！", vbExclamation + vbOKOnly, "错误"

      Exit Sub

   End If    

    'strSql = "inster into  DISTINCT A.Path_name, A.Path_des,_
        B.UserName, A.Dir_date FROM doc_path A ,yg_tab B where _
        A.Create_userid = B.userid and A.sub_id=" & intParID

    Set recTemp = objDB. ExecuteSQL ("doc_path")

    With recTemp

         .AddNew

         !path_name = txtDirName.Text

         !Path_tyep = Left(cboType.Text, 1)

         !path_dir = txtPath.Text

         !path_des = txtDes.Text

         !Create_userid = gUserId

         !Dir_date = Now

         !sub_id = CInt(Right(CurrNode.Key, 1))

         .Update

     End With

     frmBrowse.CreateTree ("")

     Unload Me

End Sub

Private Sub cmdCance_Click()

  Unload Me

End Sub

增加文件功能的实现类似上面，略。下一节我们继续讲解如何实现移动文档以及文档共享。