Помогите подправить макрос

[jurii]

Форумчане помогите с макросом. Я в этом полный ноль. Макрос не работает. На первых порах он создает резервные копии до 5-и штук, работает. Потом спустя какое-то время создаёт до 7-и штук и создаёт только последнюю копию базы данных. Помогите исправить ошибку.
SUB Databasebackup
REM The database file *.odb is copied into the Backup directory.
REM The maximum number of copies is set to 5. After that, the oldest copy is replaced.
REM This method does not cover:
REM - data entry into a database that is already open as the data are written into the *.odb file only when it is closed.
DIM oPath AS OBJECT
DIM oDoc AS OBJECT
DIM sTitle AS STRING
DIM sUrl_end AS STRING
DIM sUrl_start AS STRING
DIM i AS INTEGER
DIM k AS INTEGER
oDoc = ThisComponent
sTitle = oDoc.Title
sUrl_start = oDoc.URL
oPath = createUnoService("com.sun.star.util.PathSettings")
FOR i = 1 TO 6
IF NOT FileExists(oPath.Backup & "/" & i & "_" & sTitle) THEN
IF i > 5 THEN
FOR k = 1 TO 4
IF FileDateTime(oPath.Backup & "/" & k & "_" & sTitle) <= FileDateTime(oPath.Backup & "/" & k+1 & "_" & sTitle) THEN
i = k
EXIT FOR
END IF
NEXT
END IF
EXIT FOR
END IF
NEXT
sUrl_end = oPath.Backup & "/" & i &"_" & sTitle
FileCopy(sUrl_start,sUrl_end)
END SUB

[bigor]

Здравствуйте.
Вы бы описали, что он должен делать. Создавать каждый день копию базы, затирая последнюю пятую? При этом копируется открытый файл

[jurii]

Он делает следующее, создаёт пять резервных копий при выполнении макроса. Создалось пять копий, потом пятая копия затирается первой, первая копия затирается второй, вторая третьей, третья четвертой, четвертая пятой, и так по новой сначала.
Выдержка из источника:
Securing your database
It can sometimes happen, especially when a database is being created, that the ODB file is
unexpectedly truncated. Frequent saving after editing is therefore useful, especially when using the
Reports module.
When the database is in use, it can be damaged by operating system failure, if this occurs just as
the Base file is being terminated. This is when the content of the database is being written into the
file.
In addition, there are the usual suspects for files that suddenly refuse to open, such as hard drive
failure. It does no harm therefore to have a backup copy which is as up-to-date as possible. The
state of the data does not change as long as the ODB file remains open. For this reason, safety
subroutines can be directly linked to the opening of the file. You simply copy the file using the
backup path given in Tools > Options > LibreOffice > Paths. This macro begins to overwrite the
oldest version after five copies have been made.

[bigor]

потом пятая копия затирается первой

не совсем так, создает пять копий, потом затирает первую и пишет новую итд
Проблема в том что пишет открытый файл, и поэтому если вы запускаете макрос руками, то время создания архивных файлов получается одинаковое, и он постоянно перетирает первую копию. Попробуйте запустить макрос, сохранить базу, затем запустить еще раз макрос итд
Ну или повесить на событие открытие файла и раз 7 его открывать закрывать

[sokol92]

Еще проблема - функция FileDateTime в LO Basic возвращает String (в VBA - Date) - дату и время модификации файла в локализации по умолчанию. В ru-RU это ДД.ММ.ГГГГ ЧЧ:MM:CC. Естественно, даты в таком формате нельзя сравнивать. Самый простой обходной путь - обернуть вышеуказанную функцию в CDate, то есть:

Код Выделить Развернуть

IF CDate(FileDateTime(oPath.Backup & "/" & k & "_" & sTitle)) <= CDate(FileDateTime(oPath.Backup & "/" & k+1 & "_" & sTitle)) THEN

[jurii]

Я его повесил на открытие файла. Попробую.

[jurii]

Вставил строки выше, не работает, поначалу до 5-и копий создавал, все хорошо шло, потом опять семь копий, и сохраняет только последнюю, предыдущие копии при открытии файла не сохраняет. Просто я вручную через архиватор по времени создаю копии файла. Есть ещё какие предложения? Смысл в том, что мне нужно сохранять промежуточные версии файла перед открытием базы данных.

[sokol92]

Попробуйте такой вариант. Сохраняется в копию текущее состояние открытой базы данных.

Код Выделить Развернуть

Option Explicit

Sub Databasebackup
  Dim oPath As  Object
  Dim oDoc As  Object
  Dim sTitle As  String
  Dim i As Long
  Dim d as Date, minDate As Date, fPath As String, rPath As String
  oDoc = ThisComponent
  sTitle = oDoc.Title
  oPath = createUnoService("com.sun.star.util.PathSettings")
  minDate=DateSerial(2099,1,1)
  For i = 1 TO 5
     fPath=oPath.Backup & "/" & i & "_" & sTitle
     If Not FileExists(fPath) Then
       rPath=fPath
       Exit For
     End If
    
     d=Cdate(FileDateTime(fpath))
     If d<minDate Then
       minDate=d
       rPath=fPath
     End If
  Next i
 
  oDoc.storeToUrl rPath, Array()
  Msgbox "База данных сохранена в файл " & rpath
 End Sub 

[jurii]

sokol92 огромное спасибо, всё заработало, ещё раз спасибо.