Saving excel file at two different locations

Question

I have to do this whenever I save the excel file:

Save the file at one drive location (overwrite if same name file exists)
Go back to original location of the file and save it there as well (overwrite the file)

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim thisPath As String
    Dim oneDrivePath As String

    thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name

    ActiveWorkbook.SaveAs _
    Filename:=oneDrivePath

    Do
    Loop Until ThisWorkbook.Saved

    ActiveWorkbook.SaveAs _
    Filename:=thisPath

    Do
    Loop Until ThisWorkbook.Saved

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

But this doesn't works it's stucks in an infinte loop or Excel goes in Not Responding State. Anyidea how to achieve this task ?

The reason I can think of why it fails is maybe it's triggered everytime the file is saved but shouldn't Application.EnableEvents = False stop it from happening ? '

EDIT#1:

I tried stepping through the code it goes into Not Responding State after the Code gets though End Sub line

If you step through it with F8, what line is it sticking on? — Rodger, Jun 09 '16 at 13:43
@Rodger I tried stepping through the code it goes into `Not Responding State` after the Code gets though `End Sub` line — Stupid_Intern, Jun 09 '16 at 14:01
Have you tried this: http://stackoverflow.com/questions/14634453/how-to-use-workbook-saveas-with-automatic-overwrite ? — Tom K., Jun 09 '16 at 14:06
Is the file saved in both locations as you expected? They should be present in their respective locations by the time you step through to the `End Sub` line — Dave, Jun 09 '16 at 14:12
@Dave Yes its saved in both the locations but excel stops responding and restarts. — Stupid_Intern, Jun 09 '16 at 14:16
It seems to me possibly that because you are using `BeforeSave` to actually carry out 2 saves, perhaps you are confusing Excel somewhat in that it's unsure what save it's supposed to carry out once it completes the actions for Before the save. Try setting `Cancel = True` before End Sub to cancel the Save attempt and see if that helps — Dave, Jun 09 '16 at 14:22

score 2 · Answer 1 · answered Jun 09 '16 at 14:47

2

you don't need to loop if all your doing is saving. try the below

Sub save()
    pathForFirstSave = "C:\folder1\"
    pathForSecondSave = "C:\anotherFolder\"

    ActiveWorkbook.SaveAs Filename:=pathForFirstSave & "asdf.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWorkbook.SaveAs Filename:=pathForSecondSave & "asdf.xlsx" _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

answered Jun 09 '16 at 14:47

jellz77

324
4
15

I think I do need to loop since it takes certain time to upload files to one drive folder. – Stupid_Intern Jun 09 '16 at 14:50
before assuming you need a loop, did you try the code to see if it works? – jellz77 Jun 09 '16 at 14:51
Yes I don't need the loop but that wasn't the issue thanks anyway for pointing it out. – Stupid_Intern Jun 09 '16 at 14:54
what other issues are you having? i'm happy to update my code to help you further – jellz77 Jun 09 '16 at 14:58

score 2 · Accepted Answer · answered Jun 09 '16 at 14:59

FileCopy may be useful here, since you don't care to overwrite the data, I think that would save you the loop for saved state (since Filesystem Object would take care of resolving the network delays ideally). I'd change the logic to:
1. Save this workbook
2. Overwrite my desired location
3. User is left in the original workbook since you are only saving a copy of this workbook.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileSystemLibrary As Variant: Set FileSystemLibrary = CreateObject("Scripting.FileSystemObject")
Dim thisPath As String: thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Dim oneDrivePath As String: oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    ThisWorkbook.Save
    FileSystemLibrary.CopyFile FileSystemLibrary.GetFile(thisPath), oneDrivePath
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Saving excel file at two different locations

2 Answers2