SaveAs error (file saves before dir creation)-CodePudding

In my simple code I create a workbook and save it in newly created folder on desktop. The problem is that it works one time, and another time it produces error 1004.

I have found out the reason behind this but I don't know how to handle this. The reason is that our company has some folders synced with OneDrive (and desktop is one of them). So sometimes the file is trying to save before the previous event ends (folder isnt created and synced - which is marked with green tick) which produces the error.

Is there a way to wait till the folder is ready?

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

CodePudding user response：

An easy solution that works no matter you use OneDrive or anything else is you check in a loop if the folder was created and use a timeout to abort if nothing happened eg after 10 seconds.

I used teh File System Object because it has some useful methods.

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

CodePudding user response：

I would think of the Sync.Status property. If you manage to find access to this property, then you could pause execution of code. This is how you could handle the situation:

for a finite amount of time (5 tries, for example)
- check the value of Sync.Status of the document
- if it's synced, perform the operation you intended to perform and exit the loop
- otherwise increment the index of your tries and wait for a minute