0

Коллеги! Есть код:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayAlerts = False
    Call ThisWorkbook.SaveAs("C:\_Temp\Test2\Version\Test2_" & Format(Now(), "DDMMYY") & "_" & Format(Time(), "hhmmss"), xlWorkbookDefault)
    Application.DisplayAlerts = True
End Sub

Очень хотелось бы вместо руками жёстко прописанного пути "C:_Temp\Test2\Version\Test2_" сделать это автоматически (может как-то с ThisWorkbook.Path), чтобы данный код был универсальным для любой новой книги, требующей сохранения дубликата в указанную папку при закрытии файла (скопировал этот универсальный код + создал папку "..\Version.." где лежит этот файл и всё). То есть в папке "..\Version.." будет получаться что-то типа лога...

Поизящнее что-ли кода хочется -)

И ещё: сейчас сохраняются в папку "..\Version.." файлы с разрешением .xlsx, а надо чтобы с разрешением .xlsm

2
  • Для любой книги, в которой будет написан код? Если в одной папке не одна такая книга - как распознавать папки для их сохранения? Нужно сохранять все версии (при активной работе с книгой будет много back-up) или заменять созданный ранее файл (один back-up-файл)? 10 мар 2019 в 17:44
  • Да. Для любой книги в папке. Процесс вижу так: 1. В корне, где много файлов (которые содержат этот скрипт и которые надо бэкапить) есть папка "..\Version..", в которую будут сваливаться версии всех этих файлов; 2. Да их там будет очень много, но это ничего (пространства хватит, названия у всех файлов разные поэтому они там будуь отсортированы по названию и конфликта не будет); 3. При необходимости будем чистить папку "..\Version.."; 4. Если можн, то необходим в коде предусмотреть возможность заменять ранее созданный файл (один back-up-файл) [посмотрим по динамике наполнения папки]. Как-то так
    – 2b4fITin
    11 мар 2019 в 5:04

1 ответ 1

0

В модуль "ЭтаКнига"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sFldr As String, sFName As String
    sFldr = ThisWorkbook.Path & "\Version\" ' путь к папке для сохранения'
    If Dir(sFldr, vbDirectory) = "" Then MkDir sFldr ' создаем, если нет'

    sFName = Replace(ThisWorkbook.Name, ".xlsm", "") & _
                    "_" & Format(Now(), "ddMM_hhmmss") ' имя back-up'

    Application.DisplayAlerts = False
    ThisWorkbook.Save ' если нужно сохранить и рабочую версию'
    ThisWorkbook.SaveAs Filename:=sFldr & sFName & ".xlsm", _
                    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.DisplayAlerts = True
End Sub
2
  • Спасибо огромное!
    – 2b4fITin
    12 мар 2019 в 18:28
  • @2b4fITin, макрос остается в копиях. Они же (back-up) будут просматриваться. А после закрытия в папке создастся новая папка с back-up'ами back-up'ов... Для удаления кода используйте ThisWorkbook.VBProject.VBComponents 12 мар 2019 в 20:30

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge you have read our privacy policy.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.