将所有文件和文件夹以及所有子文件夹设为只读

Question

我有一个包含多个文件夹的文件夹，其中包含多个文件。我想使用 excel 2010 中的宏将所有文件夹中的所有文件设为只读。我尝试了下面的代码，但是当我逐步执行时，我发现sFile 永远不会填充字符串并且实习生不起作用。

Sub setFileReadOnly()
   Dim sPath As String
   Dim sFile As String

   sPath = "c:\temp\"

   sFile = Dir(sPath & "*.*")

   Do Until sFile = ""
      SetAttr sPath & sFile, vbReadOnly
      sFile = Dir
   Loop
End Sub

Answer 1

为此，您需要一个递归过程和另一个调用它的过程来启动该过程。 Dir 函数不应递归使用。在向 Microsoft Scripting Runtime 添加引用（工具 -> 引用）之后，试试这个代码。

Sub Main()

    Dim sPath As String

    sPath = "c:\temp\"

    Call setFileReadOnly(sPath)

End Sub

Sub setFileReadOnly(sPath As String)

    Dim sFile As String
    Dim sSubFolder As String
    Dim fsoObject As Scripting.FileSystemObject
    Dim folderObject As Scripting.Folder
    Dim fileObject As Scripting.File

    Set fsoObject = New Scripting.FileSystemObject

    For Each folderObject In fsoObject.GetFolder(sPath).SubFolders
        Debug.Print folderObject.Path
        Call setFileReadOnly(folderObject.Path & "\")
    Next folderObject

    For Each fileObject In fsoObject.GetFolder(sPath).Files
        Debug.Print sPath & fileObject.Name
        SetAttr sPath & fileObject.Name, vbReadOnly
    Next fileObject

End Sub

我已离开Debug.Print 声明。

Answer 2

最简单的方法是使用脚本运行时中的 FileSystemObject。您需要添加对 Microsoft Scripting Runtime 的引用或更改代码以使用后期绑定。设置起始文件夹后，您可以轻松递归所有子文件夹：

Sub SetFilesReadOnly(Optional location As Folder)
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    If location Is Nothing Then
        Set location = fso.GetFolder("C:\Temp")
    End If

    Dim target As File
    For Each target In location.Files
        target.Attributes = target.Attributes + ReadOnly
    Next target

    Dim directory As Folder
    For Each directory In location.SubFolders
        SetFilesReadOnly directory
    Next directory
End Sub