回 帖 发 新 帖 刷新版面

主题:请教 搜索c盘下所有exe文件 出问题了

' Need a ListBox, CommandBox
Option Explicit
'宣告搜寻到的文件的储存阵列变数
Private FilePackage() As String
Private Sub Command1_Click()
'宣告存放目录名称储存阵列变数
Dim DirPackage() As String
'存放文件搜寻条件之字串
Dim SearchString As String
'接收 Dir() 传回字串,并做为回圈判断的字串
Dim DirString As String
'I 目前搜寻目录的指位器,J 是 DirPackage 目录阵列之上限指标
'K 是 FilePackage 之文件阵列之上限指标
Dim I As Long, J As Long, K As Long
'把 ListBox 的旧显示资料清掉
    List1.Clear
'把 FilePackage 的上一次搜寻资料清掉
    Erase FilePackage
'假设我们的搜寻从 C 碟根目录开始
    ReDim DirPackage(0)
    '路径结尾一定要加 "\"
    DirPackage(0) = "c:\"
'假设我们的搜寻字串是 "*.exe"
    SearchString = "*.exe"
'显示沙漏指标
    Me.MousePointer = 11

'-------- 以下搜寻 C 碟  所有的目录 -----------------
'直到目录指位器 I 超过目录上限指标 J 才结束搜寻
    Do While I <= J
'搜寻目录指位器 I 所指的目录
        DirString = Dir(DirPackage(I), vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)
'直到目前目录找不到任何目录或文件才结束
        Do While DirString <> ""
'不要把上层目录和现目录的指标符号算进去
            If DirString <> "." And DirString <> ".." Then
  '如果找到的是个目录
                If (GetAttr(DirPackage(I) & DirString) And vbDirectory) _
                        = vbDirectory Then
                    '把目录上限加 1
                    J = J + 1
                    '把储存目录名称的阵列加一个
                    ReDim Preserve DirPackage(J)
                    '把查到的新目录放在 DirPackage 新元素  
                    DirPackage(J) = DirPackage(I) + DirString + "\"
'如果找到的是个文件
                Else
                    '如果与搜寻字串相符合
                    If UCase(DirString) Like UCase(SearchString) Then
                        '把储存文件名称的阵列加一个
                        ReDim Preserve FilePackage(K)
                        '把查到的新文件放在 filePackage 新元素  
                        FilePackage(K) = DirPackage(I) + DirString
                        '把文件上限加 1
                        K = K + 1
                    End If
                End If
End If
'继续找是否有符合的资料,并把结果放 DirString   
            DirString = Dir
            DoEvents
        Loop
        '把现目录指标往下移一个
        I = I + 1
    Loop
'还原鼠标指标
    Me.MousePointer = 0
If K = 0 Then
        MsgBox "没有 " & SearchString & " 的文件"
    Else
        '以下将结果输出到列示盒  
        For I = 0 To UBound(FilePackage)
            List1.AddItem FilePackage(I)
            DoEvents
        Next
MsgBox "总共找到 " & UBound(FilePackage) + 1 & " 个文件"
End If
End Sub

以上代码似乎是台湾人写的,我运行后报错"找不到路径或文件"   就是这句
If (GetAttr(DirPackage(I) & DirString) And vbDirectory) _
                        = vbDirectory Then  
奇怪的是若将 DirPackage(0) = "c:\"改为 DirPackage(0) = "d:\" 则一切正常,请问这是为什么呢?

回复列表 (共1个回复)

沙发

是写vb库函数的人脑壳短路了,其实还有很多类似的问题...
你把库函数GetAttr 换成api:GetFileAttributes 就可以了(先看下这个函数的用法),或者加个on error ...主要原因是c盘下那个系统文件hiberfil.sys是不能读的

我来回复

您尚未登录,请登录后再回复。点此登录或注册