Страницы: 1
RSS
Как сохранять копию файла в папку при открытии в название добавить дату и время сохранения
 
Ребята, добрый день, подскажите есть у кого-то в загашнике  макрос сохранения копии книги при открытии  в папку и добавить к имени дату и время сохранения...
Не бойтесь совершенства. Вам его не достичь.
 
У меня есть на закрытие :)
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 On Error GoTo finish

strDate = Format(Now, "yyyy.mm.dd-hh.mm.ss")

    ActiveWorkbook.SaveAs Filename:="c:\Tmp\RFILE." & strDate & ".xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False


finish:
End Sub

Извините, писано давно, рекордером... :)
 
Hugo, о а куда он сохраняет файл?!? или здесь не копия сохраняется?
Изменено: a.i.mershik - 17.11.2017 10:23:08
Не бойтесь совершенства. Вам его не достичь.
 
Здесь как раз получается копия, т.к. оригиналу там в процессе делается save когда если нужно, а это копия как бекап на всякий случай. И кстати иногда спасало.
Ну а кучу старого мусора из прописанного в коде каталога можно чистить скриптом например при загрузке системы.
P.S. А сохранение копии можете записать рекордером. Здесь ведь главное не в этом...
Изменено: Hugo - 17.11.2017 10:30:03
 
Hugo, да мне как раз и нужно - много данных меняется и иногда ошибочно их меняют и нужно последний вариант...спасибо большое
Не бойтесь совершенства. Вам его не достичь.
 
Hugo, а не сможете помочь.. нашел на сайте макрос...http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=15510
но срабатывает когда его запускаешь макрос. а нужно что бы автоматически  при открытии книги...
Код
Sub Save_Copy_As()   
'---------------------------------------------------------------------------------------   
' Procedure    : Save_Copy_As   
' Author       : Alex_ST   
' Topic_HEADER : Как макросом сохранить копию текущего файла?   
' Topic_URL    : http://www.planetaexcel.ru/forum.php?thread_id=16506   
' DateTime     : 08.02.12, 12:00   
' Purpose      : Сохранение копии активного файла   
' Notes        : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне)   
'---------------------------------------------------------------------------------------   
   Const sPath_in_Names = "Path4SaveCopyAs"   ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла   
   Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"    ' суффикс к имени файла копии - дата и время сохренения копии файла   
   Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$   
   Dim bReadOnlyRecommended As Boolean  
   With ActiveWorkbook   
      FileName = .Name   ' например, "Книга1.xls"   
      sExp = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1)   ' расширение файла вместе с точкой (например, ".xls")   
      FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp   ' например, "Книга1 [2012.02.06 15-24'39''].xls"   
      On Error Resume Next  
      sDirPath = .Names(sPath_in_Names).Value   ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names   
      If Err Then .Names.Add sPath_in_Names, .Path & "\": sDirPath = .Names(sPath_in_Names).Value   ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path   
      sDirPath = Mid(sDirPath, 3, Len(sDirPath) - 3)   ' убрать из считанного значения в начале "= и в конце "   
      sDirPath = sDirPath & IIf(Right(sDirPath, 1) = "\", "", "\")  ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша)   
      .Names(sPath_in_Names).Value = sDirPath   ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names   
      sFullFilePath = sDirPath & FileName   ' полный путь сохранения вместе с полным именем копии   
REPEAT_:   
      FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _   
                                               FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _   
                                               Title:="Сохранение копии файла")   'задать путь сохранения и имя копии файла в окне выбора   
      If VarType(FileName) = vbBoolean Then Exit Sub   ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем   
      If FileName = .FullName Then MsgBox "Здесь нельзя сохранить файл под таким именем!", 16, "Ошибка": GoTo REPEAT_   
      sDirPath = Left(FileName, InStrRev(FileName, "\"))   ' путь к папке сохранения копий без имени файла   
      .Names(sPath_in_Names).Value = sDirPath   ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names   
      bReadOnlyRecommended = .ReadOnlyRecommended   ' запомнить параметры исходного файла   
      .ReadOnlyRecommended = --(MsgBox("Рекомендовать открывать файл только для чтения?", 36) - 7)   ' MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7   
      .SaveCopyAs FileName   
      .ReadOnlyRecommended = bReadOnlyRecommended   ' восстановить параметры исходного файла   
   End With  
End Sub
Изменено: a.i.mershik - 17.11.2017 10:36:03
Не бойтесь совершенства. Вам его не достичь.
 
Варианты на выбор
Код
Private Sub Workbook_Open()

    Me.SaveCopyAs Replace(Me.FullName, Me.Name, Format(Date, ("dd_mm_yy_")) & Me.Name)

'    Me.SaveCopyAs Replace(Me.FullName, Me.Name, Mid$(Me.Name, 1, InStrRev(Me.Name, ".") - 1) _
        & Format(Date, ("dd_mm_yy_")) & Mid$(Me.Name, InStrRev(Me.Name, ".")))

End Sub
 
Да, наверное логически понятнее делать копию при открытии, но по факту это будет тот же файл, что и был при закрытии.
А если админы вдруг что-то ночью накосячили - то уже другой :)
 
RAN, почему-то при втором открытии книги не сохраняется файл...но если открою сохраненный файл то сохраняется...
Не бойтесь совершенства. Вам его не достичь.
 
Как это не сохраняется? Еще как сохраняется. Но СЕГОДНЯ под тем-же именем, что и первое сохранение.  :)
Так будет каждую минуту новую копию делать
Код
Me.SaveCopyAs Replace(Me.FullName, Me.Name, Format(Now, ("dd_mm_yy_hh_nn_")) & Me.Name)
Изменено: RAN - 17.11.2017 10:45:42
 
RAN, все понял, сорян, он заменяет файл....а как удалить макрос из файла который сохраняет...а то при открытии копии он еще создает) ну в смысле что бы сохранял без макроса
Изменено: a.i.mershik - 17.11.2017 10:45:34
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
a.i.mershik написал:
нашел на сайте макрос
- ух... Ну поставьте его вызов на событие закрытия, или открытия. Но зачем там диалог выбора каталога...
По поводу сохраняется/несохраняется - если в имя файла писать дату+время до секунды - нужно ооочень постараться чтоб имя совпало :)
 
Hugo, я читал понял что выбор каталога делается  раз, и делается потому что нужно что бы руководству падала копия актуальная и разные отчеты в разные места сохраняются...
Не бойтесь совершенства. Вам его не достичь.
 
Сохранить копию, и сохранить копию без макросов - это совершенно разные задачи.
 
Hugo, если бы понимать как ставить вызов на событие)
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
a.i.mershik написал:
если бы понимать как ставить вызов на событие
Код
Private Sub Workbook_Open()
call имямакроса
end sub
 
Hugo, RAN,  спасибо Всем БОЛЬШОЕ , я еще тот дуболом в макросах...
Не бойтесь совершенства. Вам его не достичь.
 
 а подскажите как удалить при сохранении копии книги макрос?
Изменено: a.i.mershik - 17.11.2017 10:55:36
Не бойтесь совершенства. Вам его не достичь.
 
Сохраняйте книгу в формате xlsx
 
RAN, ну вот Ваш макрос сохраняет при открытии копию книги но при этом в файле остается макрос а хотелось бы что бы в копии книги его не было а в основном он был.
Не бойтесь совершенства. Вам его не достичь.
 
А кстати сохранить copyas в другом формате не получится - вот тут мой подход вырывает очко! :)
 
Hugo, только вот зашел вышел а вот такая беда произошла.... чет не то я сделал)
Изменено: a.i.mershik - 17.11.2017 11:15:02
Не бойтесь совершенства. Вам его не достичь.
 
Так я говорил - запишите сохранение книги в нужном формате рекордером, из полученного кода возьмите всё нужное в свой.
 
Код
Private Sub Workbook_Open()
    Dim sFailName$, sSave$
    sFailName = Me.FullName
    sSave = Replace(Me.FullName, Me.Name, Format(Date, ("dd_mm_yy_hh_nn_")) & Me.Name)
    Application.DisplayAlerts = False
    Me.SaveAs Left$(sSave, Len(sSave) - 1) & "x", 51
    Application.EnableEvents = False
    Workbooks.Open (sFailName)
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Me.Close
End Sub
 
RAN, о спасибо большое!!!
Не бойтесь совершенства. Вам его не достичь.
 
Date на Now забыл поменять
 
Цитата
a.i.mershik написал:
и делается потому что нужно что бы руководству падала копия актуальная
- а падает... :(
Правда мой вариант тоже грешен - нужно делать копию на событие сохранения, а не на открытие/закрытие...
Изменено: Hugo - 17.11.2017 14:47:08
 
Добрый день, помогите, пожалуйста, справиться со следующей задачей.

В файле Excel формируются дашборды по странам, необходимо сохранять лист с дашбордом как pdf  в той же папке, где лежит Excel файл c указанием в названии страны(берется из ячейки I2), типа дашборда и текущей даты.
Знаю, что в Приемах есть статья на эту тему, по мотивам которой я составил вот такой макрос:
Код
Sub SplitSheets6()
    Dim AW As Window
     Set AW = ActiveWindow
    For Each s In AW.SelectedSheets
      s.ExportAsFixedFormat Filename:=ThisWorkbook.Path & "\" & s.Range("I2") & "_snapshot (1 page)" & "_" & Date & ".pdf", Type:=xlTypePDF
       Next
End Sub
Данный макрос отлично работает на моем компьютере, но при попытке выполнить его на другом компе вылазит ошибка (прилагается, файл ОШИБКА 1).

Поэтому решил переформулировать задачу: сохранять выделенный лист в формате pdf в папку, определяемую пользователем, c указанием в названии страны(берется из ячейки I2), типа дашборда и текущей даты.
Попробовал переписать код под это дело:
Код
Sub SplitSheets15()
    Dim AW As Window
     Set AW = ActiveWindow
    For Each s In AW.SelectedSheets
    s.ExportAsFixedFormat
    Type = xlTypePDF
    Filename = Application.GetSaveAsFilename( _
                 s.Range("I2") & "_snapshot (1 page)" & Date, _
                 "PDF (*.pdf),", , "Please select the appropriate folder to save the snapshot", "Save")
    Quality = xlQualityStandard
    DisplayFileAfterPublish = True
        Next
End Sub
но выдает ошибку  (прилагается, файл ОШИБКА 2)

Помогите поправить код или порекомендуйте, пожалуйста, другой.

Заранее благодарю.
Изменено: sig_vlad - 17.09.2018 12:21:23
Страницы: 1
Наверх