| 网站首页 | 新闻 | 新书 | 专家 | 技巧 | 源码作品 | 工具/资源 | 商城 | 风采 | 留言 | 论坛 | 网址 | 承接 | 
您现在的位置: Access/Office中国 >> 技巧 >> Access >> OFFICE集成系统 >> 文章正文 用户登录 新用户注册
不使用API获得指定文件夹文件列表         
不使用API获得指定文件夹文件列表
作者:goodidea… 文章来源:本站原创 点击数: 本日:{$DayHits} 更新时间:2004-10-7 21:52:58

最近为一个歌城安装vod系统时,需要找出不同目录的重复歌曲和损坏歌曲文件,这是我编写的2种不使用API列出指定文件夹下所有文件(包含子文件夹)的方法。 两种方法都支持本地磁盘目录(形如: E:\Folder\)和网络共享目录(形如: \\server\Share\)

第一种, 利用Scripting.FileSystemObject对象。此法优点是可以同时得到文件大小和属性,缺点是某些系统目录也可能被列出。请先引用Microsoft Scripting Runtime (%system%\scrrun.dll)
Public Sub SaveFileListOfPath(strFileFullPath As String)
'goodidea 2004/10/02

    Dim strFileFullName As String
    Dim fso As New Scripting.FileSystemObject '申明并实例化FileSystemObject对象
    Dim d As Scripting.Folder
    Dim sd As Scripting.Folder
    Dim f As Scripting.File
   
    On Error Resume Next
    Forms(0).lblStatus.Caption = "正在连接到: " & strFileFullPath
    Forms(0).Repaint

    Set d = fso.GetFolder(strFileFullPath) '实例化Folder对象
   
    'Debug.Print Err.Number, Err.Description
    i = 0
    For Each f In d.Files '循环文件夹中每一个文件
           
            If Err.Number = 70 Then Debug.Print "拒绝: ", d.Path
            strFileFullName = f.Path
            If i >= 10 Then '适当的时候给出一些提示
                me.lblStatus.Caption = strFileFullName
                me.Repaint
                i = 0
            End If
            i = i + 1
     '把文件信息写入到表中, g_cnn是一个公共的ADO.Connection对象
             g_cnn.Execute "insert into [tbl_file_list_temp] ([filename],[FullName],[size])" & _
                " values(""" & f.Name & """,""" & f.Path & """, " & f.Size & ")"

    Next
    Set f = Nothing

    For Each sd In d.SubFolders '循环每一个子文件夹
        Debug.Print sd.Path, sd.Type, sd.Attributes, sd.ShortName
        If UCase(sd.ShortName) <> "RECYCLER" Then
            Call SaveFileListOfPath(sd.Path) '递归调用,获得文件列表
        End If
    Next
   
    me.lblStatus.Caption = "总文件个数: " & g_cnn.Execute("select count(*) from [tbl_file_list_temp] ").GetString
    me.Repaint
   
    Set fso = Nothing
    Set d = Nothing
    Set sd = Nothing

End Sub


第二种, 利用Office.FileSearch对象。此法优点是搜索Office文件更加方便,搜索子目录无需递归。请先引用Microsoft Office ojbect Library (%system%\scrrun.dll)
Public Sub SaveFileListOfPath2(strFileFullPath As String)
'goodidea 2004/10/01

    Dim strFileFullName As String
    Dim objFileSearch  As Office.FileSearch

    Set objFileSearch = Application.FileSearch '获取FileSearch对象
    With objFileSearch

        .NewSearch '开始新的搜索
        .MatchAllWordForms = True 
        .SearchSubFolders = True '搜索子目录
        .FileType = msoFileTypeAllFiles '搜索的文件类型为所有文件
        .LookIn = strFileFullPath '在指定目录中搜索
        me.lblStatus.Caption = "正在连接 : " & strFileFullPath
        me.Repaint
        .Execute msoSortByFileName '执行搜索

        For i = .FoundFiles.Count To 1 Step -1 '循环搜索结果
            strFileFullName = .FoundFiles(i)
            If i Mod 5 = 0 Then '给出提示
                me.lblStatus.Caption = strFileFullName
                me.Repaint
            End If
     '把搜索结果写入表中, g_cnn是一个公共的ADO.Connection对象
            g_cnn.Execute "insert into [tbl_file_list_temp] ([filename],[FullName])" & _
                " values(""" & gf_getFileNameOfFullName(strFileFullName) & """,""" & strFileFullName & """)"
        Next

    End With
    me.lblStatus.Caption = "总文件个数: " & g_cnn.Execute("select count(*) from [tbl_file_list_temp] ").GetString
    me.Repaint

    Set objFileSearch = Nothing

End Sub

文章录入:goodidea    责任编辑:admin 
  • 上一篇文章:

  • 下一篇文章:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
    专 题 栏 目
    最 新 热 门
    最 新 推 荐
    相 关 文 章
    VBA自动安装和删除字体的
    如何提取分组取前N条的记
    VB创建多线程应用程序(二
    VB创建多线程应用程序(一
    在VB中调用CHM 帮助的几
    VB 6.0与大型数据库的无
    如何用VBA更改数据库密码
    在VB中用代码打印ACCESS
    如果显示Access中VBA的隐
    用VB轻松调用其他程序
    网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)