返回列表 上一主題 發帖

[發問] word vba 搜尋檔案名稱無法執行

[發問] word vba 搜尋檔案名稱無法執行

各位先進此統計表係以office 2003版製作,但因公司更新為office 2010版,其中原有部分功能無法使用
目前知道係因Application.FileSearch無法再使用,經上網查詢可使用dir代替,但自己功力不足仍無法正常執行,
還請各位先進多加指導

123.rar (16.71 KB)

將以下代碼存成模組,用法請自行測試!我不知道適不適合!

Option Explicit
Option Base 1

Public 檔案資訊陣列() As String

Public Sub 搜尋檔案(ByVal 資料夾路徑 As String, ByVal 篩選檔名 As String, ByVal 包含子資料夾 As Boolean, Optional ByVal 子資料夾階層數 As Long = 255)

    On Error Resume Next
   
    Dim 階層序 As Long
    Dim 階層數 As Long
    Dim 目前階層資料夾序 As Long
    Dim 目前階層資料夾數 As Long
    Dim 下一階層資料夾數 As Long
    Dim 檔案數 As Long
   
    Dim 資料夾路徑陣列() As String
    Dim 資料夾路徑陣列數 As Long
    Dim 檔案資訊陣列數 As Long
    Dim 資料夾或檔名 As String
   
    Erase 檔案資訊陣列
   
    If 包含子資料夾 = True Then
        If 子資料夾階層數 < 1 Then
            子資料夾階層數 = 1
        ElseIf 子資料夾階層數 > 255 Then
            子資料夾階層數 = 255
        End If
        
        階層數 = 1 + 子資料夾階層數
    Else
        階層數 = 1
    End If
   
    ReDim 資料夾路徑陣列(階層數, 1) As String
   
    資料夾路徑陣列(1, 1) = 資料夾路徑 '資料夾路徑必須經過修正,結尾帶\
   
    下一階層資料夾數 = 1
    資料夾路徑陣列數 = 1
    檔案數 = 0
    檔案資訊陣列數 = 0
    For 階層序 = 1 To 階層數
        If Not 資料夾路徑陣列(階層序, 1) = "" Then
            目前階層資料夾數 = 下一階層資料夾數
            下一階層資料夾數 = 0
            For 目前階層資料夾序 = 1 To 目前階層資料夾數
                資料夾或檔名 = Dir(資料夾路徑陣列(階層序, 目前階層資料夾序) & "*", 31)
               
                Do Until 資料夾或檔名 = ""
                    If Not 資料夾或檔名 = "." And Not 資料夾或檔名 = ".." Then
                        If (GetAttr(資料夾路徑陣列(階層序, 目前階層資料夾序) & 資料夾或檔名) And vbDirectory) = vbDirectory Then
                            If 階層序 < 階層數 Then
                                下一階層資料夾數 = 下一階層資料夾數 + 1
                                
                                If 下一階層資料夾數 > 資料夾路徑陣列數 Then
                                    資料夾路徑陣列數 = 資料夾路徑陣列數 + 99
                                    ReDim Preserve 資料夾路徑陣列(階層數, 資料夾路徑陣列數) As String
                                End If
                                
                                資料夾路徑陣列(階層序 + 1, 下一階層資料夾數) = 資料夾路徑陣列(階層序, 目前階層資料夾序) & 資料夾或檔名 & "\"
                            End If
                        Else
                            If 資料夾或檔名 Like 篩選檔名 Then
                                檔案數 = 檔案數 + 1
                                
                                If 檔案數 > 檔案資訊陣列數 Then
                                    檔案資訊陣列數 = 檔案資訊陣列數 + 999
                                    ReDim Preserve 檔案資訊陣列(1, 檔案資訊陣列數) As String
                                End If
                                
                                檔案資訊陣列(1, 檔案數) = 資料夾或檔名
                            End If
                        End If
                    End If
                    
                    資料夾或檔名 = Dir
                Loop
            Next 目前階層資料夾序
        Else
            Exit For
        End If
    Next 階層序
   
    ReDim Preserve 檔案資訊陣列(1, 檔案數) As String

End Sub

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題