使用Workbooks.Open(ReadOnly:=False)仍无法以写入模式打开Excel文件

核心原因 #

你当前运行脚本的工作簿（ThisWorkbook）已经在当前Excel实例中处于打开状态，此时用新的Excel实例（CreateObject("Excel.Application")）尝试以可写模式打开同一文件，系统会强制设为只读模式——这是Excel的文件锁定机制导致的，同一个Excel文件不能同时在两个不同实例中以可写状态打开。

解决方案 #

1. 直接操作当前已打开的工作簿（最推荐）

不需要创建新的Excel实例，直接对当前运行脚本的工作簿进行操作，完全规避只读问题：

Sub read_Test1()
    Dim val As Variant
    Dim lrow As Long
    Dim cell_val() As Variant
    Dim newCell_val() As Variant
    Dim fp As String, fn As String, newFileName As String
    Dim RowCount As Long
    Dim j As Long, k As Long, m As Long
    Dim str_tmp As String
    Dim ws As Worksheet
    
    fn = ThisWorkbook.FullName
    fp = ThisWorkbook.Path
    
    ' 直接使用当前工作簿，无需新建Excel实例
    Set ws = ThisWorkbook.Sheets("Sheet2")
    RowCount = ws.UsedRange.Rows.Count

    ' 动态重新定义数组大小（适配0起始索引）
    ReDim cell_val(RowCount - 1)
    ReDim newCell_val(RowCount - 1)

    For j = 1 To RowCount
        cell_val(j - 1) = ws.Cells(j, 1).Value
    Next

    For k = 1 To 3
        str_tmp = cell_val(k - 1) ' 默认赋值，避免未替换时为空
        If InStr(str_tmp, "<DIV>") > 0 Then
            str_tmp = Replace(str_tmp, "<DIV>", "", 1, -1, vbTextCompare)
        End If
        newCell_val(k - 1) = str_tmp
    Next

    For m = 1 To 3
        ws.Cells(m, 2).Value = newCell_val(m - 1)
    Next
    
    ' 最后统一保存，无需循环内多次重复保存
    ThisWorkbook.Save
End Sub

2. 排查外部锁定因素

如果坚持要用新实例打开，先确认以下几点：

• 关闭当前工作簿（注意：脚本会随工作簿关闭终止，需调整执行逻辑）
• 检查文件是否被其他进程占用（比如文件预览器、其他用户打开、杀毒软件扫描）
• 右键文件→属性，取消「只读」勾选
• 确认文件所在文件夹有写入权限

3. 关于ChangeFileAccess无效的说明

因为文件是被跨实例打开强制设为只读，ChangeFileAccess无法突破Excel的跨实例文件锁定机制，所以此方法无效。

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