сохранение резервной копии общей книги, раз в день

Пользователь

Сообщений: 94 Регистрация: 01.01.1970

02.09.2009 16:18:46

Здравствуйте.
в приёмах нашел макрос
Sub Backup_Active_Workbook()
Dim x As String
strPath = "c:\TEMP"
On Error Resume Next
x = GetAttr(strPath) And 0
If Err = 0 Then ' если путь существует - сохраняем копию книги
strDate = Format(Now, "dd/mm/yy hh-mm")
FileNameXls = strPath & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".xls"
ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
Else 'если путь не существует - выводим сообщение
MsgBox "Папка " & strPath & " недоступна или не существует!", vbCritical
End If
End Sub

а как сделать чтобы книга сохранялась раз в день?? Private Sub Workbook_BeforeClose не подходит потому что книга может открываться и закрываться несколько раз в день. и как будет работать этот макрос если книга в общем доступе??? будет сохраняться каждому открывшему её???

alexeyk Пользователь Сообщений: 35 Регистрация: 01.01.1970	#2 02.09.2009 16:33:20 strDate = Format(Now, "dd/mm/yy hh-mm") заменить на strDate = Format(Now, "dd/mm/yy) будет сохранятся раз в день. На сколько я помню в общем доступе макросы не работают.

slav

Пользователь

Сообщений: 232 Регистрация: 01.01.1970

02.09.2009 16:47:27

{quote}{login=alexeyk}{date=02.09.2009 04:33}{thema=}{post}strDate = Format(Now, "dd/mm/yy hh-mm")
заменить на
strDate = Format(Now, "dd/mm/yy)
будет сохранятся раз в день.
{/post}{/quote}
На мой взгляд вы ошибаетесь.
strDate в данном макросе используется для присвоения имени файлу бэкапа книги.
и если мне память не изменяет, то для ежедневного бэкапа нужно использовать конструкцию типа
Application.OnTime TimeValue("17:00:00"), "Backup_Active_Workbook"
которая ежедневно в 17.00.00 будет запускать процедуру Backup_Active_Workbook()

slav Пользователь Сообщений: 232 Регистрация: 01.01.1970	#4 02.09.2009 16:49:48 тыц в поиск, кстати http://www.planetaexcel.ru/forum.php?thread_id=4933

ГРЫША Гость	#5 02.09.2009 18:14:47 А время сохранения книги имеет значение? С первого открытия с последнего?

alexeyk

Пользователь

Сообщений: 35 Регистрация: 01.01.1970

02.09.2009 19:12:57

Можно и Application.OnTime TimeValue("17:00:00"), "Backup_Active_Workbook", но где вероятность что в это время Excel будет запущен и архивация произойдет.

Если хотите сохранять архив и быть уверенными что бэкап произойдет в нужное время, лучше используйте сторонние программы архивации, например AzovSky Verison Safe.

Архивацию можно сделать при каждом запуске файла excel, как только откроется сам файл. Написал пример, где архивация будет производится один раз в день при открытии файла.

Private Sub Workbook_Open()

On Error Resume Next
pathSave = "c:\Архив"

Set fs = CreateObject("Scripting.FileSystemObject")
curFolderExists = fs.FolderExists(pathSave)

'Удалите эту строчку из макроса, чтобы не раздражала других ползователей
If curFolderExists = False Then MsgBox "На том компьютере, где будет создана папка для резерва, будут создаваться архивные копии" + Chr(10) + "для этого создайте папку " + pathSave + " для архива"

fname = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
fname = pathSave + "\" + fname + "_" + Format(Now, "DD_MM_YY") + ".xls"
curFileExists = fs.FileExists(pathSave)
If curFileExists = False Then
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs fname
Application.DisplayAlerts = True
End If

End Sub

ГРЫША

Гость

02.09.2009 19:54:26

Я сделал может и коряво, но очень просто:
В любой ячейке, в нерабочей области листа за пределами экрана, я вставил функцию =СЕГОДНЯ() Например в ячейке AA1
При открытии книги, сравнивается с ячейкой АА1 ячейка АВ1. Если даты разные, делаю копию книги в заранее созданную папку АРХИВ, но с другим именем, и переписываю дату из АА1 в АВ1. И сегодня копий больше делаться не будет, ибо дата в АА1 поменяется только завтра. Копия всегда одна.

Sub Auto_open()
If Range("AB1") <> Range("AA1") Then
PT = "C:\АРХИВ\ИМЯ_КОПИИ" & ".xls"
ActiveWorkbook.SaveCopyAs PT
Range("AB1") = Range("AA1")
End If
End Sub

Если нужна копия за каждый день, в ИМЯ_КОПИИ можно добавить дату

Sub Auto_open()
If Range("AB1") <> Range("AA1") Then
DT = Range("AA1")
PT = "C:\АРХИВ\ИМЯ_КОПИИ_"& DT & ".xls"
ActiveWorkbook.SaveCopyAs PT
Range("AB1") = Range("AA1")
End If
End Sub

Не смейтесь! У меня работает!!!!

alexeyk

Пользователь

Сообщений: 35 Регистрация: 01.01.1970

02.09.2009 20:14:57

извиняюсь, допустил ошибочку, исправил

Private Sub Workbook_Open()

On Error Resume Next
pathSave = "c:\Архив"

Set fs = CreateObject("Scripting.FileSystemObject")
curFolderExists = fs.FolderExists(pathSave)

'Удалите эту строчку из макроса, чтобы не раздражала других ползователей
If curFolderExists = False Then MsgBox "На том компьютере, где будет создана папка для резерва, будут создаваться архивные копии" + Chr(10) + "для этого создайте папку " + pathSave + " для архива"

fname = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
fname = pathSave + "\" + fname + "_" + Format(Now, "DD_MM_YY") + ".xls"
curFileExists = fs.FileExists(fname)
If curFileExists = False Then
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs fname
Application.DisplayAlerts = True
End If

End Sub

bandanas Пользователь Сообщений: 94 Регистрация: 01.01.1970	#9 04.09.2009 12:51:15 {quote}{login=alexeyk}{date=02.09.2009 08:14}{thema=}{post}извиняюсь, допустил ошибочку, исправил 'Удалите эту строчку из макроса, чтобы не раздражала других ползователей If curFolderExists = False Then MsgBox "На том компьютере, где будет создана папка для резерва, будут создаваться архивные копии" + Chr(10) + "для этого создайте папку " + pathSave + " для архива" End Sub{/post}{/quote} т.е. резервная копия будет сохраяняться только у того юзверя, у которого есть папка c:\Архив???? и в догонку вопрос, что нужно добавить чтобы макрос проверял уже имеющиеся резервные копии, и удалял копии старше недели???

Читают тему