如何在不关闭Outlook的前提下释放PST文件的占用锁？

完全可以在不关闭Outlook的前提下释放PST文件锁，你当前脚本锁无法释放的核心原因是：RemoveStore仅从Outlook会话的导航面板移除PST存储项，MAPI底层对PST的文件句柄是异步释放的，默认会有几十秒到数分钟的延迟，且你未主动清理持有的COM对象引用，导致句柄残留。

优化后实现代码 #

1. 新增辅助检测函数（判断PST锁是否释放） #

Function IsFileUnlocked(filePath As String) As Boolean
    On Error Resume Next
    Open filePath For Binary Access Read Write Lock Read Write As #1
    Close #1
    IsFileUnlocked = (Err.Number = 0)
    Err.Clear
End Function

2. 修改后的PST卸载逻辑（无需关闭Outlook） #

Sub CLOSEMSGSTORE_NoQuit()
    Dim objStores As Outlook.Stores
    Dim objStore As Outlook.Store
    Dim objOutlookFile As Outlook.Folder
    Dim i As Integer
    Dim pstPaths As Variant
    Dim waitCount As Integer
    
    ' 这里填你所有PST的路径，用于后续检测锁状态
    pstPaths = Array("E:\2012.pst", "E:\2013.pst", "E:\2014.pst", _
                    "E:\2015.pst", "E:\2016.pst", "E:\2017.pst", _
                    "E:\2018.pst", "E:\2019.pst", "E:\2020.pst", _
                    "E:\2021.pst")

    Set objStores = Outlook.Session.Stores

    ' 倒序移除所有非Exchange的PST存储
    For i = objStores.Count To 1 Step -1
        Set objStore = objStores.Item(i)
        If objStore.ExchangeStoreType = olNotExchange Then
            Set objOutlookFile = objStore.GetRootFolder
            Outlook.Session.RemoveStore objOutlookFile
            ' 立刻释放当前存储的COM引用
            Set objOutlookFile = Nothing
            Set objStore = Nothing
        End If
    Next

    ' 释放全局COM对象
    Set objStores = Nothing
    ' 触发VBA垃圾回收，强制释放未引用的COM句柄
    Dim gc As Object
    Set gc = CreateObject("System.GC")
    gc.Collect
    gc.WaitForPendingFinalizers
    Set gc = Nothing

    ' 等待所有PST锁释放，最多等待30秒
    waitCount = 0
    Do While waitCount < 30
        Dim allUnlocked As Boolean
        allUnlocked = True
        For Each path In pstPaths
            If Dir(path) <> "" Then ' 仅检测存在的PST文件
                If Not IsFileUnlocked(path) Then
                    allUnlocked = False
                    Exit For
                End If
            End If
        Next
        If allUnlocked Then Exit Do
        waitCount = waitCount + 1
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop

    ' 到这里所有PST锁已经释放，Dropbox可以正常同步
End Sub

注意事项 #

• 建议只在需要查询历史邮件时加载对应PST，查询完成立刻调用上述卸载脚本，避免长时间持有锁导致同步冲突
• 不要使用第三方工具强制解锁PST文件，可能导致文件结构损坏、数据丢失
• 如果遇到极个别锁无法释放的情况，可手动在Outlook导航栏右键点击PST存储，选择「关闭」，触发即时释放逻辑

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