在我的簡單代碼中,我創建了一個作業簿并將其保存在桌面上新創建的檔案夾中。 問題是它一次有效,另一次產生錯誤 1004。
我已經找到了這背后的原因,但我不知道如何處理。原因是我們公司有一些檔案夾與 OneDrive 同步(桌面就是其中之一)。因此,有時檔案會在前一個事件結束之前嘗試保存(檔案夾未創建和同步 - 標有綠色勾號),這會產生錯誤。
有沒有辦法等到檔案夾準備好?
Sub TestSave()
Dim wb As Workbook
Set wb = Workbooks.Add
Application.DisplayAlerts = False
MkDir CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Test_Folder"
wb.SaveAs FileName:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "Test_Folder\Test_File.xlsx"
wb.Close
Application.DisplayAlerts = True
End Sub
uj5u.com熱心網友回復:
一個簡單的解決方案,無論您使用OneDrive還是其他任何方式都可以使用,如果檔案夾已創建,則檢查回圈,如果沒有發生任何事情(例如 10 秒后),則使用超時中止。
我使用了檔案系統物件,因為它有一些有用的方法。
Option Explicit
Public Sub Example()
Dim wb As Workbook
Set wb = Workbooks.Add
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim SavePath As String ' create your save path
SavePath = FSO.BuildPath(WshShell.SpecialFolders("Desktop"), "Test_Folder")
' if save path does not exist yet create it
If Not FSO.FolderExists(SavePath) Then
FSO.CreateFolder SavePath
End If
Const Timeout As Long = 10 ' seconds to wait for folder creation
Dim Tmr As Single
Tmr = Timer ' initialize timer
Do While Not FSO.FolderExists(SavePath) ' loop until path exists
DoEvents
' abort if timeout is reached so you don't end up in an endless loop if something goes wrong
If Tmr Timeout <= Timer Then
MsgBox "The folder '" & SavePath & "' could not becreated within " & Timeout & " seconds. File could not be saved.", vbCritical
Exit Sub
End If
Loop
' save and close file
wb.SaveAs Filename:=SavePath & Application.PathSeparator & "Test_File.xlsx"
wb.Close SaveChanges:=False
End Sub
uj5u.com熱心網友回復:
我會想到Sync.Status屬性。如果您設法找到對此屬性的訪問權限,那么您可以暫停代碼的執行。你可以這樣處理這種情況:
- 在有限的時間內(例如 5 次嘗試)
- 檢查
Sync.Status檔案的值 - 如果已同步,則執行您打算執行的操作并退出回圈
- 否則增加你嘗試的索引并等待一分鐘
- 檢查
轉載請註明出處,本文鏈接:https://www.uj5u.com/caozuo/352727.html
上一篇:如何將文本檔案讀入二維陣列?
