日期：2023年3月10日
作者：Commas
签名：(ง •_•)ง 积跬步以致千里,积小流以成江海……
注释：如果您觉得有所帮助，帮忙点个赞，也可以关注我，我们一起成长；如果有不对的地方，还望各位大佬不吝赐教，谢谢^ - ^
1.01³⁶⁵ = 37.7834；0.99³⁶⁵ = 0.0255
1.02³⁶⁵ = 1377.4083；0.98³⁶⁵ = 0.0006

在这里插入图片描述

文章目录

一、前言
二、设置与取消文件只读权限
三、判断文件只读
四、实现过程

一、前言

当一个文件（Word、Excel、PPT等等）编辑的差不多了，准备保存的时候，哟，好家伙，发现该文件权限设置为只读（readonly）了，无法保存，心情突然没那么美丽了。其实很简单解决这个问题，如下所示：

在这里插入图片描述

右键选择“属性”→取消“只读”的勾选，那么example.docx文件就取消只读，可以正常保存了。另外还有什么压缩传输法，文件另存法，微信降级法等等，虽然可以解决问题，但是也太不方便了。

后面排查发现，原来是最近微信更新后出现的问题——微信传输的文件均被设置成了只读（readonly）权限，给出的说法是为了防止文件信息在网络传输过程中被篡改。但是也太不方便了吧，作为一名技术不能忍，于是乎搞出一个小程序chmod.exe，将这个exe放在微信下载文件夹下面，运行就可以把整个文件夹中所有的文件取消只读了，看下效果吧：

双击运行，效果如下：
再次双击运行，效果如下：

好了，话不多说，我们接下来讲讲如何实现吧……

最后面放了程序与源码的下载地址^ - ^

二、设置与取消文件只读权限

VB6中的VBA库提供了一个方法SetAttr()，可以设置文件的读写等等权限。

语法：

VBA.SetAttr(PathName As String,Attributes As VbFileAttribute)

或

SetAttr(PathName As String,Attributes As VbFileAttribute)

PathName：必要参数。需要修改只读属性的文件路径或目录路径；
Attributes：必要参数。常数或数值表达式，其总和用来表示文件的属性；

attributes 参数设置可为：

常数	值	描述
`vbNormal`	`0`	常规（缺省值），可读可写
`vbReadOnly`	`1`	只读
`vbHidden`	`2`	隐藏
`vbSystem`	`4`	系统文件
`vbArchive`	`32`	上次备份以后，文件已经改变

设置只读示例：

'set the file readoly
Call VBA.SetAttr(App.Path & "\example.txt",vbReadOnly)

或

'set the file readoly
Call VBA.SetAttr(App.Path & "\example.txt",1)

取消只读示例：

'cancel the file readonly
Call VBA.SetAttr(App.Path & "\example.txt", vbNormal)

或

'cancel the file readonly
Call VBA.SetAttr(App.Path & "\example.txt", 0)

三、判断文件只读

VB6中的VBA库提供了一个方法GetAttr()，可以设置文件的读写等等权限。

语法：

VBA.GetAttr(PathName As String) As VbFileAttribute

或

GetAttr(PathName As String) As VbFileAttribute

PathName：必要参数。需要修改只读属性的文件路径或目录路径；
VbFileAttribute：返回值是一个 十进制 的Integer，此为一个文件、目录、或文件夹的属性值总和；

由 GetAttr 返回的值，是下面这些属性值的总和：

常数	值(十进制)	值(二进制)	描述
`vbNormal`	`0`	`0`	常规
`vbReadOnly`	`1`	`1`	只读
`vbHidden`	`2`	`10`	隐藏
`vbSystem`	`4`	`100`	系统文件
`vbDirectory`	`16`	`10000`	目录或文件夹
`vbArchive`	`32`	`10000`	上次备份以后，文件已经改变
`vbalias`	`64`	`1000000`	指定的文件名是别名

特别说明

若要判断是否设置了某个属性，在 GetAttr 函数与想要得知的属性值之间使用 And 运算符与逐位比较。如果所得的结果不为零，则表示设置了这个属性值，即：

result = GetAttr(PathName) And VbFileAttribute

如果 result <> 0 ，那么表示设置 VbFileAttribute 权限；
如果 result = 0 ，那么没有设置 VbFileAttribute 权限；

只读示例：

Dim result As Integer
result = GetAttr(App.Path & "\example.txt", 0) And vbReadOnly
If result <> 0 Then
    Debug.Print "文件设置了只读权限"
Else
    Debug.Print "文件未设置只读权限"
End If

只要result <> 0，就表示文件设置了只读权限，其中用到了一个【And 运算符与逐位比较 】知识点，如果读者感兴趣，那么到时候再出一期详细讲讲吧，这里展开讲解的话，可以话题就跑偏了。

上述判断文件权限，大部分习惯高级语言的小伙伴们都不太适应吧，所以我将其封装了下，健康绿色，可以放心食用，如下所示：

Private Function CheckFileReadOnly(ByVal sFilePath As String) As Boolean
On Error Resume Next
'函数说明：判断文件是否为只读
'创建作者：Commas
'创建时间：2022-02-16
'修改时间：
'------数据格式说明------
'sFilePath：文件路径
'------数据格式说明------
    CheckFileReadOnly = False
    
    If sFilePath <> "" Then
        If Dir(sFilePath, vbDirectory + vbNormal + vbArchive + vbHidden + vbReadOnly + vbSystem) <> "" Then
            If (VBA.GetAttr(sFilePath) And vbReadOnly) <> 0 Then
                CheckFileReadOnly = True
            End If
        End If
    End If
End Function

四、实现过程

现在我们实现的是一个文件的权限设置，如果就这么去取消只读权限，那还不如直接右键属性直接取消来的快，所以需要用到目录遍历（如果想详细了解这方面的知识，可以看我的另一篇博文《VB6遍历目录（文件夹和文件）》）。

首先，我们封装一下单个文件的取消只读权限

Private Function CancelFileReadOnly(ByVal sFilePath As String) As Boolean
On Error Resume Next
'函数说明：文件取消只读
'创建作者：Commas
'创建时间：2022-02-16
'修改时间：
'------数据格式说明------
'sFilePath：文件路径
'------数据格式说明------
    Err.Clear
    
    VBA.SetAttr sFilePath, vbNormal
    
    If Err <> 0 Then
        CancelFileReadOnly = False
        Err.Clear
    Else
        CancelFileReadOnly = True
    End If
End Function

然后，我们获取路径下的所有目录（文件夹目录+文件目录）

Set clnDir = GetAllDir(sFindPathName)

接着，我们遍历目录clnDir来取消文件只读

For i = 1 To clnDir.Count
    sCurFilePath = clnDir.Item(i)
    
    '判断文件是否未只读
    If CheckFileReadOnly(sCurFilePath) Then
        sCurFileName = Mid(sCurFilePath, InStrRev(sCurFilePath, "\") + 1)
        
        '取消文件只读权限
        If CancelFileReadOnly(sCurFilePath) Then
            clnOK.Add sCurFileName
        Else
            clnFail.Add sCurFileName
        End If
    End If
Next i

最后，将遍历过程封装成函数，即批量取消只读权限（BatchCancelFileReadOnly）

Private Function BatchCancelFileReadOnly(ByVal sFindPathName As String) As Boolean
On Error Resume Next
'函数说明：文件取消只读
'创建作者：Commas
'创建时间：2022-02-16
'修改时间：
'------数据格式说明------
'sFindPathName：文件夹路径
'------数据格式说明------
    Dim sCurFileName As String, sCurFilePath As String, i As Long
    Dim clnOK As New Collection, clnFail As New Collection, clnDir As New Collection
    
    ' 获取查询路径下所有目录（包括子孙）
    Set clnDir = GetAllDir(sFindPathName)
    
    For i = 1 To clnDir.Count
        sCurFilePath = clnDir.Item(i)
        
        '判断文件是否未只读
        If CheckFileReadOnly(sCurFilePath) Then
            sCurFileName = Mid(sCurFilePath, InStrRev(sCurFilePath, "\") + 1)
            
            '取消文件只读权限
            If CancelFileReadOnly(sCurFilePath) Then
                clnOK.Add sCurFileName
            Else
                clnFail.Add sCurFileName
            End If
        End If
    Next i
    
    If clnFail.Count = 0 Then
        BatchCancelFileReadOnly = True
    Else
        BatchCancelFileReadOnly = False
    End If
    
    Dim sMsg As String
    If clnOK.Count > 0 Or clnFail.Count > 0 Then
        addMsg sMsg, "******操作完成，详情如下******"
        addMsg sMsg, "执行路径：" & sFindPathName
        addMsg sMsg, ""
    End If
    'ok
    If clnOK.Count > 0 Then
        addMsg sMsg, ""
        addMsg sMsg, "@@@@已取消【只读】的文件如下所示："
    End If
    For i = 1 To clnOK.Count
        addMsg sMsg, clnOK(i)
    Next
    'fail
    If clnFail.Count > 0 Then
        addMsg sMsg, ""
        addMsg sMsg, "@@@@取消【只读】失败的文件如下所示："
    End If
    For i = 1 To clnFail.Count
        addMsg sMsg, clnFail(i)
    Next
    If sMsg = "" Then sMsg = "经检查，【路径" & sFindPathName & "】没有【只读】文件"
    MsgBox sMsg
End Function

调用示例：

Sub Main()
    Dim sPath As String
    'VBA.Command$ 也可以从命令行参数提取path，这里暂时没有实现
    sPath = App.Path
    
    Debug.Print BatchCancelFileReadOnly(sPath)
End Sub