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
| Private Sub CmdMakeBackUp_Click()
'1. Generate unique incremented name for new Backup (= Name + User + Date + Increment in brackets if needed)
Dim ObjectRootName As String, ObjectFullName As String
ObjectRootName = "Actes_BackUp_" & _
FctGetUserInitial(CrtUserID) & "_" & _
DatePart("d", Now) & "_" & DatePart("m", Now) & "_" & DatePart("yyyy", Now)
ObjectFullName = ObjectRootName
'2. Iterate Table collection to detect existing backups
Dim db As DAO.Database, tdf As DAO.TableDef, TableAlreadyExists As Boolean, i As Long, ii As Long
Set db = CurrentDb
TableAlreadyExists = False
i = 1
ii = 0
For Each tdf In db.TableDefs
If (tdf.Attributes And dbSystemObject) = 0 Then
If tdf.Name = ObjectFullName Then
TableAlreadyExists = True
ObjectFullName = ObjectRootName & " (1)"
End If
If Right(tdf.Name, 1) = ")" Then
i = (Left((Right(tdf.Name, 2)), 1)) + 1
ObjectFullName = ObjectRootName & " (" & i & ")"
End If
End If
ii = ii + 1
Next tdf
Set db = Nothing
'3. Create a local copy of linked Table "ActesTempCopy" (avoid using brackets)
Dim SourceDBPath As String
SourceDBPath = GetDBPath & "Data\VetoDBaseActes.accdb"
DoCmd.TransferDatabase acImport, "Microsoft Access", (SourceDBPath), acTable, "Actes", "ActesTempCopy"
'4. Cull records belonging to sibling company
DoCmd.RunSQL "DELETE ActesTempCopy.*, ActesTempCopy.VetStructureID " & _
"FROM ActesTempCopy " & _
"WHERE (((ActesTempCopy.VetStructureID)<>" & CrtVetStructureID & "));"
'5. Rename Table with full name including brackets if any
DoCmd.Rename ObjectFullName, acTable, "ActesTempCopy"
'6. Update display
UpdateMyBackUpList
EnableMyButtons
End Sub |
