Excel VBA中的自動saveloop

Question

所以我有這段代碼，打開后每30分鍾保存一次Excel文件。 效果很好，但是當打開數據庫文件時，Excel文件被鎖定並且無法保存。 循環中斷，我必須重新啟動excel文件才能使其再次工作。 任何人都有解決方案嗎？ 這是代碼btw：

Private Sub workbook_open()
Application.OnTime Now + TimeValue("00:30:00"), "SaveWb"

End Sub

Sub SaveWb()
Workbooks("Shared.xlsm").Save
Application.OnTime Now + TimeValue("00:30:00"), "SaveWb"

On Error Resume Next

End Sub

Answer 1

此代碼解決了我的問題，您可以用自己的文件路徑替換。

Public Function FileInUse(sFileName) As Boolean
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0
End Function


Sub SaveWb()
myFilePath = "\\server\Klaverkaas Algemeen\Database Access\BackEnd\Database Klaverkaas klein.accdb"
If FileInUse(myFilePath) Then
    Application.OnTime Now + TimeValue("01:00:00"), "SaveWb"
Else
    Workbooks("Shared.xlsm").Save
    Application.OnTime Now + TimeValue("01:00:00"), "SaveWb"
End If
End Sub

並在myworkbook中使用它

Private Sub workbook_open()
Application.OnTime Now + TimeValue("01:00:00"), "SaveWb"

End Sub