- 帖子
- 122
- 主題
- 26
- 精華
- 0
- 積分
- 148
- 點名
- 0
- 作業系統
- windos10
- 軟體版本
- office2016
- 閱讀權限
- 20
- 註冊時間
- 2021-7-8
- 最後登錄
- 2023-8-28
|
2#
發表於 2023-8-11 10:51
| 只看該作者
回復 1# cowww
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"
ThisWorkbook.SaveAs filename:=newFileName, WriteResPassword:="6112", ReadOnlyRecommended:=True
Else
ThisWorkbook.SaveAs filename:=targetFilePath, WriteResPassword:="6112", ReadOnlyRecommended:=True
End If
============================================================================================
Private Sub Workbook_Open()
'指定07:45開始執行"full_calc"
Application.OnTime TimeValue("17:00:00"), "full_calc"
End Sub
測試發現上述兩段語法好像會造成"違反共用原則"的異常出現
請問這個問題有辦法解決嗎?? |
|
