使所有文件和文件夹以及所有子文件夹只读

I have a folder that contains multiple folders which contain multiple files. I would like to use a macro from excel 2010 to make all of the files in all of the folders read only. I tried the code below but as I step through it I find that sFile never gets populated with a string and intern does not work.

我有一个包含多个文件夹的文件夹,其中包含多个文件。我想使用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

2 个解决方案

#1

You need a recursive procedure for this and another procedure that calls it to start the process. The Dir function should not be used recursively. Try this code, after adding a reference (Tools -> References) to the Microsoft Scripting Runtime.

您需要一个递归过程以及另一个调用它来启动过程的过程。不应递归使用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

I have left in the Debug.Print statements.

我已经离开了Debug.Print语句。

#2

The easiest way to do this is with the FileSystemObject in the scripting runtime. You'll need to either add a reference to Microsoft Scripting Runtime or change the code to use late binding. After you set your starting folder, you can easily recurse all sub folders:

最简单的方法是使用脚本运行时中的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