Ошибка сохранения (файл сохраняется до создания директории)

#excel #vba #file #directory

Вопрос:

В моем простом коде я создаю книгу и сохраняю ее во вновь созданной папке на рабочем столе. Проблема в том, что он работает один раз, а в другой раз выдает ошибку 1004.

Я выяснил причину этого, но я не знаю, как с этим справиться. Причина в том, что у нашей компании есть несколько папок, синхронизированных с OneDrive (и рабочий стол является одним из них). Поэтому иногда файл пытается сохраниться до завершения предыдущего события (папка не создана и не синхронизирована, что отмечено зеленой галочкой), что приводит к ошибке.

Есть ли способ дождаться, пока папка будет готова?

 Sub TestSave()

Dim wb As Workbook
Set wb = Workbooks.Add
Application.DisplayAlerts = False
MkDir CreateObject("WScript.Shell").SpecialFolders("Desktop") amp; "Test_Folder"
wb.SaveAs FileName:=CreateObject("WScript.Shell").SpecialFolders("Desktop") amp; "" amp; "Test_FolderTest_File.xlsx"
wb.Close
Application.DisplayAlerts = True

End Sub
 

Комментарии:

1. Простое решение: После MkDir проверки, существует ли папка. Делайте это в цикле (с DoEvents ), пока папка не появится или не пройдет 10 секунд (чтобы вы не оказались в бесконечном цикле, если что-то пойдет не так). Таким образом, вы даете время, необходимое для создания каталога (но не более 10 секунд).

Ответ №1:

Простое решение, которое работает независимо от того, используете вы 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 '" amp; SavePath amp; "' could not becreated within " amp; Timeout amp; " seconds. File could not be saved.", vbCritical
            Exit Sub
        End If
    Loop
    
    ' save and close file
    wb.SaveAs Filename:=SavePath amp; Application.PathSeparator amp; "Test_File.xlsx"
    wb.Close SaveChanges:=False
End Sub
 

Ответ №2:

Я бы подумал о свойстве Sync.Status. Если вам удастся найти доступ к этому свойству, вы можете приостановить выполнение кода. Вот как вы могли бы справиться с ситуацией:

  • в течение конечного промежутка времени (например, 5 попыток)
    • проверьте значение Sync.Status документа
    • если он синхронизирован, выполните операцию, которую вы намеревались выполнить, и выйдите из цикла
    • в противном случае увеличьте индекс ваших попыток и подождите минуту