Function IsFileOpen(filePath As String) As Boolean
Dim fileNum As Integer
fileNum = FreeFile()
On Error Resume Next
Open filePath For Binary Access Read Write Lock Read Write As fileNum
If Err.Number <> 0 Then
IsFileOpen = True
End If
Close fileNum
On Error GoTo 0
End Function
Dim targetFilePath As String
targetFilePath = "\\shl-group.com\dept\MFMG\對外單位開放資料\會議室模具追蹤資訊\急件專案狀態追蹤_v2_1.xlsm"
If IsFileOpen(targetFilePath) Then
' 檔案已被開啟，執行另存新檔的動作
Dim currentDate As String
currentDate = Format(Date, "yyyymmdd") ' 取得當天日期的字串表示，例如：20230522
Dim newFileName As String
newFileName = "\\shl-group.com\dept\MFMG\對外單位開放資料\會議室模具追蹤資訊\急件專案狀態追蹤_v2_1_" & currentDate & ".xlsm"
將語法改成這樣就沒有出現"違反共用原則"的錯誤訊息了
Function IsFileOpen(filePath As String) As Boolean
Dim fso As Object
Dim file As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set file = fso.OpenTextFile(filePath, 1)
If Err.Number = 0 Then
IsFileOpen = False
file.Close
Else
IsFileOpen = True
End If
On Error GoTo 0
Set file = Nothing
Set fso = Nothing
End Function
======================================
Private Sub Workbook_Open()
Application.OnTime TimeValue("17:00:00"), "full_calc"
End Sub
