Access911.net   |   a9BBS   |   OTaA System  
  搜索文章:  
Access911欢迎您光临  
   主页      上传      繁體版       论坛     
设为首页  |  加入收藏   
  
你现在的位置:文章索引 -> 文章分类 -> VBA  
 首页|  近日更新|  下载  |  文章索引  |  搜索|  术语|  承接工程|  
 
系统正在加载内容,请耐心等待...
 
 查询
 窗体
 报表
 
 
 VBA
 函数
 ADO/DAO/ADO.NET
 API
 ADP
 安全
 发布
 OA
 ASP/ASP.NET
 其他语言
 控件
 DELPHI
 C#/.Net
 本站
 其他
 小例程
 常用软件
 参考文档
 业主作品
 网友大作
 
 
友情链接
 access911.net
 
访问人次
 1701897
 
站长 E-Mail
 net911@sina.com
 access911@gmail.com
 
RSS 订阅

显示附加信息 >>>

如何用ACCESS管理光盘(一)文件搜索

作者:cg1  摘自:access911.net  :cg1  更新日期:2008-10-4  浏览人次:

 

问题:

如何用ACCESS管理光盘(一)文件搜索

我的DVD-R光盘已经上百张了,我想用ACCESS来管理光盘及其中的文件,该如何入手呢?
如何获取指定盘符下所有文件?
如果文件很多,在搜索时能否有进度条?
是否能返回符合条件的文件,而不是所有文件都返回呢?

 

问题:


要实现光盘管理主要功能就是记录光盘的卷标、光盘中文件名及文件大小、其他针对光盘或者文件的附加描述及关键字的添加及搜索。实现了上述几个功能基本就可以算作光盘管理软件了。

技术要点:
1、如何获取指定盘符下所有文件
2、如何获取光盘卷标
3、如何设计数据库结构
4、如何快速搜索到需要的文件
5、如何设计界面方便操作
6、如何以标准格式导出数据库内的信息

今天首先来解决第一个技术要点。
要找到指定目录下的所有文件方法很多,比如本站已经介绍过的用Dir函数来实现:

    如何得到某个目录下所有的文件名? 
    http://www.access911.net/?kbid;78FAB01E17DC 
 
这里再介绍使用 FSO 的方法,因为本次我们不只要获取文件名,而且要获取文件大小、最后修改日期等信息。

以下我们使用 Scripting.Folder.SubFolders 集合就可以得到一个文件夹下的所有子文件夹,用 Scripting.Folder.Files 集合就可以得到一个文件夹下的所有文件对象。为了便于以后编写光盘管理软件,这里将上述对象封装为3个类,以提供额外的进度条、统计、用户选择功能。

示例下载:
http://access911.net/down/eg/eg_AnalyseFolder_2007.zip(70KB)
简体中文版 Office Access 2007 + 简体中文版 Windows 2003 Server R2 测试通过

核心类:clsSearchFolder 类
Option Compare Database

'===========================================================
' 类名        :  clsSearchFolder
' 版本号      :  1.0
' 说明        :  根据用户选择的目录,将该目录下,包括子目录中
'                 所有的文件及文件夹都找出来,并用 Dictionary
'                 集合返回。文件及文件夹的选择由调用本类的程序
'                 通过订阅事件来灵活判断。
'                 文件选定后也有事件触发,便于调用的程序处理。
'                 处理的进度用事件抛出给调用本类的程序。
'                 为了便于演示,本示例中所有代码都没有加错误处
'                 理,请读者注意!
' 引用        :  Microsoft Office 12.0 Object Library
'                 Microsoft Scripting Runtime
' 调用演示    :  请参考 FrmAnalyseFolder 窗体中的代码
' 最后修改日期:  2008-10-4 17:36:00
' 示例地址    :  http://access911.net/?kbid;72FABF1E12DCECF3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Private blnStopProcess As Boolean   '字段,决定是否终止操作。
Private dblTimerStart As Double     '操作时间
Public InitialFileName As String    '文件对话框开始的目录
Public Files As Dictionary          '将搜索到符合条件的文件通过这个属性公布出去
Public Folders As Dictionary        '将搜索到符合条件的文件夹通过这个属性公布出去

'公布一个事件,将目前处理进度返回给调用本类的程序
Public Event ProgressChange(ByVal percent As Double, _
                            ByVal runtime As Double, _
                            ByVal raiseSource As String, _
                            ByVal message As String)

'公布选择文件的事件,让用户可以在类外部控制对应文件是否要操作。
'按地址传递的Cancel参数用于让用户确定该文件是否要处理。

Public Event FileSearching(ByVal f As clsMyFile, ByRef Cancel As Boolean)

'公布选择文件夹的事件,让用户可以在类外部控制对应文件夹是否要操作。
'按地址传递的Cancel参数用于让用户确定该文件夹是否要处理。

Public Event FolderSearching(ByVal f As clsMyFolder, ByRef Cancel As Boolean)

'在文件找到后公布事件,让用户可以针对找到并选择的文件作其他操作,比如统计等操作。
Public Event FileFound(ByVal f As clsMyFile)

'在文件夹找到后公布事件,让用户可以针对找到并选择的文件夹作其他操作,比如统计等操作。
Public Event FolderFound(ByVal f As clsMyFolder)

'在搜索结束后触发一个事件,并通过 succeed 参数告知订阅者是否运行成功
Public Event SearchEnd(ByVal f As clsMyFolder, ByVal succeed As Boolean)

'停止属性,只读。用于在长时间搜索操作中,外部用户可以终止操作。
Public Property Let StopProcess(ByVal isStop As Boolean)
    blnStopProcess = isStop
End Property

'与用户交互,选择一个目录,并自动搜索该目录中所有文件及子文件夹。
Function SelectFolder()
    Dim fd As Office.FileDialog
    Dim varSelect As Variant
    Dim fso As New Scripting.FileSystemObject
    Dim lngAC As Long
    Dim myFld As New clsMyFolder
       
    '触发进度事件,将一切进度条归0
    RaiseEvent ProgressChange(0, 0, "File", "准备开始选择目录...")
    Set Files = New Dictionary
    Set Folders = New Dictionary
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.AllowMultiSelect = False
    fd.InitialFileName = InitialFileName
    If fd.Show = True Then
        dblTimerStart = Timer()
        For Each varSelect In fd.SelectedItems
            Set myFld.BaseInfor = fso.GetFolder(varSelect)
            lngAC = GetAllSubFile(myFld)
            Folders.Add myFld.BaseInfor.Path, myFld.BaseInfor
            '搜索结束,根据 blnStopProcess 状态判断是用户手动停止还是运行成功。
            If blnStopProcess = True Then
                RaiseEvent SearchEnd(myFld, False)
            Else
                RaiseEvent SearchEnd(myFld, True)
            End If
            Debug.Print myFld.SizeCount, myFld.SubFilesCount, myFld.SubFoldersCount
        Next
    Else
        RaiseEvent SearchEnd(myFld, False)
    End If
    RaiseEvent ProgressChange(1, Timer() - dblTimerStart, _
                        "File", "全部完成!" & lngAC & "个文件被找到。")
End Function

'统计某个目录中包含多少个子目录及文件。
'返回值表示该目录包括其子目录中一共有多少文件

Private Function GetAllSubFile(ByVal fld As clsMyFolder) As Long
    Dim f As File
    Dim fldSub As Folder
    Dim blnIsCanceled As Boolean
    Dim lngThisFolderFilesCount As Long
    Dim mFle As clsMyFile
    Dim mFld As clsMyFolder
    
    '按客户指令终止程序
    If blnStopProcess = True Then
        Exit Function
    End If
    
    For Each f In fld.BaseInfor.Files
        lngThisFolderFilesCount = lngThisFolderFilesCount + 1
        '按客户指令终止程序
        If blnStopProcess = True Then
            Exit Function
        End If
        RaiseEvent ProgressChange(lngThisFolderFilesCount / fld.BaseInfor.Files.Count, _
                                  Timer() - dblTimerStart, _
                                  "File", _
                                  f.Path)
        '找到的文件是否符合条件,由调用本类的程序来决定。
        blnIsCanceled = False
        Set mFle = New clsMyFile
        Set mFle.BaseInfor = f
        RaiseEvent FileSearching(mFle, blnIsCanceled)
        If blnIsCanceled = False Then
            DoEvents
            Files.Add f.Path, f
            '统计文件数、文件夹数、文件大小
            fld.AddCount f.Size, 0, 1
            RaiseEvent FileFound(mFle)
        End If
    Next
    
    For Each fldSub In fld.BaseInfor.SubFolders
        '按客户指令终止程序
        If blnStopProcess = True Then
            Exit Function
        End If
        '找到了某个目录,是否要继续在其子目录中进行搜索,可以由调用本类的程序来决定。
        blnIsCanceled = False
        Set mFld = New clsMyFolder
        Set mFld.BaseInfor = fldSub
        RaiseEvent FolderSearching(mFld, blnIsCanceled)
        If blnIsCanceled = False Then
            Folders.Add fldSub.Path, fldSub
            GetAllSubFile mFld
            DoEvents
            '统计文件数、文件夹数、文件大小
            fld.AddCount mFld.SizeCount, mFld.SubFoldersCount + 1, mFld.SubFilesCount
            RaiseEvent FolderFound(mFld)
        End If
    Next
    GetAllSubFile = fld.SubFilesCount
End Function


clsMyFile 类:
Option Compare Database
'===========================================================
' 类名        :  clsMyFile
' 版本号      :  1.0
' 说明        :  自定义文件类。为了便于以后扩展,对
'                 Scripting.File 作几个属性的增加。
' 引用        :  Microsoft Scripting Runtime
' 最后修改日期:  2008-10-4 17:36:00
' 示例地址    :  http://access911.net/?kbid;72FABF1E12DCECF3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Public BaseInfor As Scripting.File  '基本信息
Public Description As String        '对这个文件的描述。便于以后编写光盘管理软件。
Public KeyWords As String           '自定义的关键字,多关键字用英文逗号分隔。便于以后编写光盘管理软件。

clsMyFolder 类:
Option Compare Database
'===========================================================
' 类名        :  clsMyFolder
' 版本号      :  1.0
' 说明        :  自定义文件夹类。为了便于以后扩展,对
'                 Scripting.Folder 作几个属性的增加。
' 引用        :  Microsoft Scripting Runtime
' 最后修改日期:  2008-10-4 17:36:00
' 示例地址    :  http://access911.net/?kbid;72FABF1E12DCECF3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Public BaseInfor As Folder      '基本信息
Public SizeCount As Double      '包含的所有子文件大小总计
Public SubFoldersCount As Long  '包含的所有子文件夹数量
Public SubFilesCount As Long    '包含的所有子文件数量
Public Description As String    '对这个文件夹的描述。便于以后编写光盘管理软件。
Public KeyWords As String       '自定义的关键字,多关键字用英文逗号分隔。便于以后编写光盘管理软件。


'对文件数文件大小进行统计
Public Sub AddCount(ByVal filesSize As Double, _
                    ByVal foldersCount As Long, _
                    ByVal filesCount As Long)
    With Me
        .SizeCount = .SizeCount + filesSize
        .SubFoldersCount = .SubFoldersCount + foldersCount
        .SubFilesCount = .SubFilesCount + filesCount
    End With
End Sub



调用上述类的窗体界面如图:

调用代码如下:
Option Compare Database
Dim WithEvents sf As clsSearchFolder

'开始文件搜索
Private Sub Command2_Click()
    Set sf = New clsSearchFolder
    sf.InitialFileName = "c:\a.bat"
    sf.SelectFolder
End Sub

'停止文件搜索
Private Sub Command4_Click()
    sf.StopProcess = True
End Sub

Private Sub Form_Open(Cancel As Integer)
    '加载右侧的帮助文字
    Me.Text1.Value = Me.Label31.Caption
    
    '加载指定日期
    Me.DateLastModified.RowSource = Format(DateAdd("d", -1, Now()), "yyyy-mm-dd") & ";" & _
         Format(DateAdd("d", -7, Now()), "yyyy-mm-dd") & ";" & _
         Format(0, "yyyy-mm-dd")
End Sub

'在 clsSearchFolder 外通过订阅事件的方法来确定搜索到的文件是否要进行处理。
'如果不需要处理,设定参数 Cancel 为 true 即可。
'以下代码中判断文件的最后修改日期是否大于指定日期,小于等于指定日期的不进行处理。

Private Sub sf_FileSearching(ByVal f As clsMyFile, Cancel As Boolean)
    If IsNull(Me.DateLastModified) = False Then
        If f.BaseInfor.DateLastModified <= Me.DateLastModified.Value Then
            Cancel = True
        End If
    End If
End Sub


'===========================================================
' 过程名      :  sf_ProgressChange
' 版本号      :  1.0
' 说明        :  在 clsSearchFolder 外通过订阅事件的方法来显示进度
' 引用        :  --
' 输入参数    :  percent,双精度,小于1的小数,用于表示当前的进度百分比
'                 runtime,双精度,用于表示当前程序已经耗用的时间,单位为秒
'                 raiseSource,文本,常量 File,表示当前事件从哪里触发
'                 message,文本,表示当前进度的文本信息
' 输出值      :  --
' 返回值      :  --
' 调用演示    :  --
' 最后修改日期:  2008-10-4 17:36:00
' 示例地址    :  http://access911.net/?kbid;72FABF1E12DCECF3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Private Sub sf_ProgressChange(ByVal percent As Double, _
                              ByVal runtime As Double, _
                              ByVal raiseSource As String, _
                              ByVal message As String)
    If percent >= 1 Then
        Me.ProgressBar1.Width = Me.ProgressBox1.Width
    Else
        Me.ProgressBar1.Width = Me.ProgressBox1.Width * percent
    End If
    Me.ProgressPercent1.Caption = Round(percent * 100, 2) & "%"
    Me.ProgressMessage.Caption = "已耗时:" & runtime \ 3600 & " 小时 " & _
        (runtime Mod 3600) \ 60 & " 分 " & runtime Mod 60 & "秒  " & vbCrLf & message
    DoEvents
    Me.Repaint
End Sub

'搜索操作结束后将触发SearchEnd事件,通过判断 succeed 参数来判断是否运行成功
'succeed 为 true 表示运行成功,succeed 为 False 表示用户终止或者运行失败

Private Sub sf_SearchEnd(ByVal f As clsMyFolder, ByVal succeed As Boolean)
    Dim f1 As Scripting.Folder
    Dim i As Long
    
    If succeed = True Then
        MsgBox "运行结束,共找到" & f.SubFilesCount & "个文件," & _
                f.SubFoldersCount & "个文件夹,文件总大小" & f.SizeCount & "字节。"
        '这里还可以通过 sf.Files 集合和 sf.Folders 集合获取'
        '刚才搜索到的所有文件及文件夹,以便以后处理

        For i = 0 To sf.Folders.Count - 1
            Set f1 = sf.Folders.Items(i)
            Debug.Print f1.Name
        Next
    Else
        MsgBox "运行终止,用户取消了该操作。"
    End If
End Sub


 


 

 
相关文章
     没有手动相关文章
 
评论
     查看或发表更多的评论,请单击这里。
 
 
 
 
 
   
  Access911.net   |   a9BBS   |   OTaA System   |
建站日期:2000年4月2日  |  设计施工:陈格 ( access911 & cg1 )
 Copyright © 2000 - 2003 COMET, 陈格 保留所有权利