應用程式 VBA/檔案和資料夾實用程式

摘要

第一組實用程式集中在基本FileSystemObject集合上；也就是說，用於查詢檔案或資料夾是否存在、大小以及是否具有特定屬性的集合。還提供了基本的路徑解析過程。所有這些過程都需要在 VBA 編輯器中引用Microsoft Scripting Runtime。
沒有發現普遍有用的程式碼來測試開啟的檔案。雖然存在許多過程，但它們在某種程度上都失敗了，通常無法識別開啟的文字或影像檔案，或者標記為只讀的 Office 檔案。問題的根源是，Windows 中的許多此類檔案在使用者開啟時不會鎖定，因此嘗試透過嘗試獲得唯一訪問許可權來檢測開啟狀態的過程無法做到這一點。任何擁有通用解決方案的讀者都可以隨時發表評論。

VBA 說明

有時需要知道檔案或資料夾是否具有特定屬性，例如，為了避免隱藏或系統檔案出現在列表中。過程HasAttribute執行此操作，將檔案路徑作為引數以及一個簡短程式碼來標識感興趣的屬性。但是，屬性包隨所有屬性編號值相加一起提供，因此此類測試，就像涉及常量的其他列舉（例如；訊息框型別）一樣，利用AND函式來拆分包。

例如：（參見下面的 HasAttribute 過程。）假設從 GetAttr 獲得的屬性包等於 37
並且我們只測試“系統”屬性（“S”）與 vbSystem = 4。現在，對於數字，
AND 運算子對每列執行按位 AND 運算，因此給出

0100101₂ = 37₁₀ = vbArchive + vbSystem + vbReadOnly
0000100₂ = 4₁₀ = vbSystem
_______
0000100₂ = 4₁₀，布林變數解釋為 True，因為它不為零

也就是說，“系統”屬性存在於屬性包中。
如果“系統”屬性未設定，則結果將全部為零。

重要的是要注意，返回值只測試一次一個屬性；也就是說，雖然檔案對於只讀（“R”）返回true，但它也可能具有未測試的其他屬性。如果使用者希望在一個字串中返回所有檔案或資料夾屬性，則可以做一些工作來連線結果程式碼。

ParsePath 過程中給出了檔案路徑解析的示例。該示例使用Split函式將所有反斜槓分隔的項放入陣列中，然後重新組合它們以建立路徑。類似的方法，以點進行拆分，用於建立檔名和字尾。

VBA 程式碼模組

Option Explicit

Function FileFound(sPath As String) As Boolean
    'returns true if parameter path file found
    
    Dim fs As FileSystemObject
          
    'set ref to fso
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'test for file
    FileFound = fs.FileExists(sPath)
        
    Set fs = Nothing
    
End Function

Function FolderFound(sPath As String) As Boolean
    'returns true if parameter path folder found
    
    Dim fs As FileSystemObject
          
    'set ref to fso
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'test for folder
    FolderFound = fs.FolderExists(sPath)
        
    Set fs = Nothing
    
End Function

Function GetFileSize(sPath As String, nSize As Long) As Boolean
    'returns file size in bytes for parameter path file
    
    Dim fs As FileSystemObject, f As File
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If fs.FileExists(sPath) Then
        Set f = fs.GetFile(sPath)
        nSize = f.Size
        GetFileSize = True
    End If

    Set fs = Nothing: Set f = Nothing

End Function

Function GetFolderSize(sPath As String, nSize As Long) As Boolean
    'returns total content size in bytes for parameter path folder
    
    Dim fs As FileSystemObject, f As Folder
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If fs.FolderExists(sPath) Then
        Set f = fs.GetFolder(sPath)
        nSize = f.Size
        GetFolderSize = True
    End If
    
    Set fs = Nothing: Set f = Nothing

End Function

Function HasAttribute(sPath As String, sA As String) As Boolean
    'returns true if parameter path file or folder INCLUDES test parameter
    'eg: if sA= "H" then returns true if file attributes INCLUDE "hidden"
    'Untested attributes might also exist
    
    'sA values
    '"R"; read only, "H"; hidden, "S"; system, "A"; archive
    '"D"; directory, "X"; alias, "N"; normal
        
    Dim bF As Boolean, nA As Integer
    Dim bFile As Boolean, bFldr As Boolean
    Dim fs As FileSystemObject, f As File, fd As Folder
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'check path parameter
    bFile = fs.FileExists(sPath)
    bFldr = fs.FolderExists(sPath)
    
    If bFile Or bFldr Then
        'get its attribute bundle
        nA = GetAttr(sPath)
    Else
        'neither found so exit
        MsgBox "Bad path parameter"
        GoTo Wayout
    End If
        
    'early exit for no attributes
    If nA = 0 And sA = "N" Then                   '0
        HasAttribute = True
        Exit Function
    End If
    
    'test for attribute in sA
    'logical AND on number variable bit columns
    If (nA And vbReadOnly) And sA = "R" Then      '1
        bF = True
    ElseIf (nA And vbHidden) And sA = "H" Then    '2
        bF = True
    ElseIf (nA And vbSystem) And sA = "S" Then    '4
        bF = True
    ElseIf (nA And vbDirectory) And sA = "D" Then '16
        bF = True
    ElseIf (nA And vbArchive) And sA = "A" Then   '32
        bF = True
    ElseIf (nA And vbAlias) And sA = "X" Then     '64
        bF = True
    End If
    
    HasAttribute = bF

Wayout:
    Set fs = Nothing: Set f = Nothing: Set fd = Nothing

End Function

Function ParsePath(sPath As String, Optional sP As String, _
                   Optional sF As String, Optional sS As String) As Boolean
    'sPath has full file path
    'returns path of file with end backslash (sP),
    'file name less suffix (sF), and suffix less dot(sS)
    
    Dim vP As Variant, vS As Variant, n As Long
    Dim bF As Boolean, fs As FileSystemObject
        
    'set ref to fso
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'test that file exists
    bF = fs.FileExists(sPath)

    If Not bF Then
        'MsgBox "File not found"
        GoTo Wayout
    End If
        
    'make array from path elements split on backslash
    vP = Split(sPath, "\")
    
    'make array from file name elements split on dot
    vS = Split(vP(UBound(vP)), ".")

    'rebuild path with backslashes
    For n = LBound(vP) To UBound(vP) - 1
        sP = sP & vP(n) & "\"
    Next n
     
    sF = vS(LBound(vS))
    sS = vS(UBound(vS))

    ParsePath = True

Wayout:
    Set fs = Nothing

End Function

參見

外部連結