Creation of backup on open when file is stored in Microsoft one drive

[dpaton05]

I want to backup a spreadsheet upon open but it is stored on Microsoft one drive. Can someone help me please?

 

[NdNoviceHlp]

Hi dpaton05. Where do you want to back up the file to? Your pc? To OneDrive? Do you want to automate this with a workbook open event or just back up the file before you access it? HTH. Dave

 

[dpaton05]

Hey Dave, my name is Dave too

I don't really know what I want as I don't really know what is possible. I know that it is important to have backups of data so I wanted to automate the creation of a backup. Currently, the data is stored in OneDrive so I imagine the backup would be best stored in OneDrive. For the backup, I think having a copy of the file would be enough.

 

[NdNoviceHlp]

These R the Dave's I no I no.... Not sure where you want to automate the backup from? Are you opening/accessing the one drive wb from another wb and just want to back up the file before you access it? Dave

 

[dpaton05]

I have multiple people accessing the file. I was thinking that I could get some code that would create a copy of the file in one drive as soon as it is opened. This would mean anyone who opened it, would cause a backup to be made with the current time and date, as long as there wasn't a backup named the same in a backup folder in one drive.

 

[NdNoviceHlp]

Hi again Dave. It seems that this is the same? Backup creation upon open
Not sure that I understand the difference? Dave

 

[NdNoviceHlp]

Re-read the link post. You can trial this. It seems to work. Every back up file has the same code and will generate a back up file when opened. Only one file per minute can have the same name. If several files with the same name (opened at the same time) are used and then saved they will replace each other as they have the same name. Seems like a nightmare. Anyways, release the Kraken. HTH. Dave
Module code...

Public Sub BackUpOneDrive()
'Create back up file on onedrive
Dim DestFile As String, FSO As Object, CurrentDate As String
Dim SrcFile As String, FolderName As String

'****change file name and foldrpath to suit
SrcFile = "YourFileName" '***File name with NO file extension ie. NO ".xlsm"
FolderName = "\Documents\YourFoldername\" 'one drive folder location

On Error GoTo erfix
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'save copy of file as temp file
ActiveWorkbook.SaveCopyAs Environ$("temp") & "" & SrcFile
'make back up path
CurrentDate = Format(Now, "dd.mm.yy hh.mm AM/PM")
DestFile = (Environ("onedrive") & FolderName & SrcFile & "_" & CurrentDate & ".xlsm")
Set FSO = CreateObject("Scripting.FileSystemObject")
'copy temp file to back up path
FSO.CopyFile Environ$("temp") & "" & SrcFile, DestFile, True 'source,destination,save
'remove temp file
Kill Environ$("temp") & "" & SrcFile

erfix:
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Backup Error"
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FSO = Nothing
End Sub

ThisWorkbook code...

Private Sub Workbook_Open()
Call BackUpOneDrive
End Sub

 

[NdNoviceHlp]

Had a re-think. That was just saving the original file again and again. This will back up the file that's opened. Dave

Public Sub BackUpOneDrive()
'Create back up file on onedrive
Dim DestFile As String, FSO As Object, CurrentDate As String, Splitter As Variant
Dim SrcFile As String, FolderName As String, FileNm As String

SrcFile = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
If InStr(SrcFile, "_") Then
Splitter = Split(ActiveWorkbook.Name, "_")
FileNm = Splitter(0)
Else
FileNm = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
End If

'****change folderpath to suit
FolderName = "\Documents\YourFoldername\"  'one drive folder location

On Error GoTo erfix
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'save copy of file as temp file
ActiveWorkbook.SaveCopyAs Environ$("temp") & "" & SrcFile
CurrentDate = Format(Now, "dd.mm.yy hh.mm AM/PM")
'make back up path
DestFile = (Environ("onedrive") & FolderName & FileNm & "_" & CurrentDate & ".xlsm")
Set FSO = CreateObject("Scripting.FileSystemObject")
'copy temp file to back up path
FSO.CopyFile Environ$("temp") & "" & SrcFile, DestFile, True 'source,destination,save
'remove temp file
Kill Environ$("temp") & "" & SrcFile

erfix:
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Error"
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FSO = Nothing
End Sub