Synchronize saving files into multiple locations?

Option Explicit
Const strBackUpFolder = "C:\MyBackups"
Const strAppName = "Documents"
Const strSecName = "For Backup"
 
Private Sub Document_Close()
    'call back up macro after close
    Application.OnTime DateAdd("s", 1, Now), "BackUpFiles"
End Sub
 
Private Sub BackUpFiles()
    Dim i As Integer
    Dim bClosed As Boolean
    Dim strForBackUp() As String
    Dim strParts() As String
    Dim strFile As String
    Dim v As Variant
    Dim doc As Document
    
    v = GetAllSettings(strAppName, strSecName)
    If Not IsEmpty(v) Then
        strForBackUp = v
        For i = 0 To UBound(strForBackUp)
            strParts = Split(strForBackUp(i, 1), "\")
            strFile = strParts(UBound(strParts))
            bClosed = True
            For Each doc In Documents
                bClosed = True
                If UCase$(doc.Name) = UCase$(strFile) Then
                    bClosed = False
                    Exit For 'not yet closed
                End If
            Next doc
            If bClosed Then
                FileCopy strForBackUp(i, 1), strBackUpFolder & "\" & strFile
                DeleteSetting strAppName, strSecName, strForBackUp(i, 0)
            End If
        Next i
    End If
End Sub
 
Sub FileSave()
    ActiveDocument.Save
    RememberForBackup
End Sub
 
Sub FileSaveAs()
Dim dlg As Dialog
Set dlg = Dialogs(wdDialogFileSaveAs)
    If dlg.Show = -1 Then
        RememberForBackup
    End If
End Sub
Sub RememberForBackup()
    Dim i As Integer
    Dim f As Integer
    Dim strForBackUp() As String
    Dim v As Variant
    
    v = GetAllSettings(strAppName, strSecName)
    If Not IsEmpty(v) Then
        strForBackUp = v
        For i = 0 To UBound(strForBackUp)
            If UCase$(ActiveDocument.Name) = UCase$(strForBackUp(i, 1)) Then
                Exit Sub 'already in list
            End If
            If strForBackUp(i, 0) > f Then
                f = strForBackUp(i, 0) + 1
            End If
        Next i
    End If
    SaveSetting strAppName, strSecName, f, ActiveDocument.Name
 
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74: