如何通过VBA控制工作簿仅宏调用时可读写，直接打开则只读？

针对你遇到的「Template宏打开Database可读写，手动打开则只读」的需求，之前的方法因为打开后再传参数时机太晚，无法生效。以下是两种实用的解决方案：

方案一：通过命令行参数传递权限标识 #

利用Excel支持命令行启动并传递参数的特性，让Template的宏通过Shell命令打开Database时附加自定义参数，Database在打开时检测参数判断是否允许读写。

1. Template工作簿中的宏代码 #

用Shell启动Excel并打开Database，同时带上自定义权限参数：

Sub OpenDatabaseForWrite()
    Dim excelExePath As String
    Dim dbFilePath As String
    Dim shellCommand As String
    
    ' 获取Excel程序路径
    excelExePath = Application.Path & "\EXCEL.EXE"
    ' 替换为你的Database实际路径
    dbFilePath = "C:\Your\Path\Database.xlsx"
    
    ' 构造命令行：Excel程序路径 + Database路径 + 自定义权限参数
    shellCommand = """" & excelExePath & """ """ & dbFilePath & """ /AllowWriteAccess"
    
    ' 执行命令打开Database
    Shell shellCommand, vbNormalFocus
End Sub

2. Database工作簿中的打开事件代码 #

在Database的ThisWorkbook模块中编写Workbook_Open事件，读取命令行参数判断权限：

Private Sub Workbook_Open()
    Dim cmdArguments As Variant
    Dim i As Integer
    Dim hasWritePermission As Boolean
    
    hasWritePermission = False
    ' 拆分命令行参数
    cmdArguments = Split(Command(), " ")
    
    ' 遍历参数查找我们的权限标识
    For i = LBound(cmdArguments) To UBound(cmdArguments)
        If cmdArguments(i) = "/AllowWriteAccess" Then
            hasWritePermission = True
            Exit For
        End If
    Next i
    
    ' 无权限则设为只读
    If Not hasWritePermission Then
        ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    End If
End Sub

方案二：用临时文件作为权限标识 #

Template的宏在打开Database前创建一个临时文件，Database打开时检测该文件是否存在，存在则允许读写（随后删除临时文件），不存在则设为只读。

1. Template工作簿中的宏代码 #

Sub OpenDatabaseForWrite()
    Dim tempFlagPath As String
    tempFlagPath = Environ("TEMP") & "\DB_Write_Flag.tmp"
    
    ' 创建临时标识文件
    Open tempFlagPath For Output As #1
    Close #1
    
    ' 打开Database
    Workbooks.Open "C:\Your\Path\Database.xlsx"
    
    ' 删除临时文件（避免残留导致误判）
    On Error Resume Next
    Kill tempFlagPath
    On Error GoTo 0
End Sub

2. Database工作簿中的打开事件代码 #

Private Sub Workbook_Open()
    Dim tempFlagPath As String
    tempFlagPath = Environ("TEMP") & "\DB_Write_Flag.tmp"
    
    If Dir(tempFlagPath) <> "" Then
        ' 检测到临时文件，允许读写并删除标识
        Kill tempFlagPath
    Else
        ' 无标识文件，设为只读
        ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    End If
End Sub

补充优化 #

为避免Template宏异常退出导致临时文件残留，可在Database的事件中增加时间判断：如果临时文件创建时间超过5分钟，则直接删除并设为只读：

Private Sub Workbook_Open()
    Dim tempFlagPath As String
    tempFlagPath = Environ("TEMP") & "\DB_Write_Flag.tmp"
    
    If Dir(tempFlagPath) <> "" Then
        ' 检查文件创建时间是否在5分钟内
        If DateDiff("n", FileDateTime(tempFlagPath), Now) <= 5 Then
            Kill tempFlagPath
        Else
            ' 过期文件，设为只读并删除
            ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
            Kill tempFlagPath
        End If
    Else
        ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
    End If
End Sub

为什么原方法无效？ #

原代码中Workbooks.Open执行时已经完成了Database的打开流程，Workbook_Open事件也已经触发，此时再通过Application.Run传递参数，无法改变已经完成的打开权限设置，因此必须在打开前传递标识，让Database在启动阶段就能检测到并调整权限。

内容的提问来源于stack exchange，提问作者Zackatach101