Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 28.02.2009, 20:32   #1
nemoomen
Пользователь
 
Регистрация: 26.02.2009
Сообщений: 58
По умолчанию Програмное сохранение книги на флешку.

Господа прошу подсказать!

Работаем в постоянно открытой книге, находящейся на одном из компов в сетке. Необходимо нарабортанную на данный момент книгу "сбросить" на носитель ( желательно програмно в VBA) и при этом "не уйти" вместе с книгой на флешку.

Есть такая возможность?
nemoomen вне форума
Старый 28.02.2009, 21:03   #2
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Такая возможность есть:
Код:
Sub Save_ThisWorkbook_Copy()    ' сохраняет копию файла
    ThisWorkbook.SaveCopyAs "e:\Workbook_Backup " & Format(Now, "dd-mmm-yyyy hh-mm-ss") & ".xls"
End Sub
При этом текущее имя и путь файла не изменяются.
Сохранённая копия получает имя типа Workbook_Backup 28-фев-2009 23-00-37.xls

Замените в коде букву диска e: на букву флеш-диска.

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

Есть возможность макросом создавать ZIP-архив (средствами Windows), или RAR \ SFX-архив средствами WinRAR
(у архива SFX расширение exe)

Пример создания SFX-архива описан здесь: http://forum.developing.ru/showpost....4&postcount=10
То есть, при желании из VBA можно создавать запароленный архив нужных файлов из выбранной папки с указанием текущего времени.

Пример кода для создания ZIP-архива:
Код:
Sub Zip_thisWorkbook()
    DefPath = "e:\"
    'Create date/time string and the temporary xls/zip file names
    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & strDate & ".zip"
    FileNameXls = DefPath & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & strDate & ".xls"
    If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then
        'Make copy of the thisWorkbook
        ThisWorkbook.SaveCopyAs FileNameXls         'Create empty Zip File
        NewZip (FileNameZip)         'Copy the file in the compressed folder
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameZip).CopyHere FileNameXls       'Keep script waiting until Compressing is done
        On Error Resume Next
        Do Until oApp.Namespace(FileNameZip).Items.Count = 1
            Application.Wait (Now + TimeValue("0:00:01"))
        Loop
        On Error GoTo 0
    End If
    Kill FileNameXls    ' удаляем временно созданный файл Excel
    MsgBox "Создан архив:  " & FileNameZip, vbInformation, "Готово"
    'Set fs = CreateObject("Scripting.FileSystemObject"):    'fs.MoveFile FileNameZip, "d:\"
End Sub

Sub NewZip(sPath)
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub

Последний раз редактировалось EducatedFool; 28.02.2009 в 21:28.
EducatedFool вне форума
Старый 28.02.2009, 22:30   #3
nemoomen
Пользователь
 
Регистрация: 26.02.2009
Сообщений: 58
По умолчанию

Превеликая моя благодарность, мастер Йодо!!!
nemoomen вне форума
Старый 03.07.2009, 19:55   #4
ivanant
Новичок
Джуниор
 
Регистрация: 13.05.2009
Сообщений: 1
По умолчанию

а подскажите как подправить код,
Sub Save_ThisWorkbook_Copy() ' сохраняет копию файла
ThisWorkbook.SaveCopyAs "e:\Workbook_Backup " & Format(Now, "dd-mmm-yyyy hh-mm-ss") & ".xls"
End Sub

если файл уже такой существует, чтобы процедура добавляла к имени _1, _2 и тд
ivanant вне форума
Старый 05.07.2009, 22:34   #5
vostok
Форумчанин
 
Регистрация: 29.04.2009
Сообщений: 119
По умолчанию

Цитата:
Сообщение от ivanant Посмотреть сообщение
а подскажите как подправить код,
Sub Save_ThisWorkbook_Copy() ' сохраняет копию файла
ThisWorkbook.SaveCopyAs "e:\Workbook_Backup " & Format(Now, "dd-mmm-yyyy hh-mm-ss") & ".xls"
End Sub

если файл уже такой существует, чтобы процедура добавляла к имени _1, _2 и тд
НЕ существует, т.к. имя меняется ежесекундно

Код:
Sub Save_ThisWorkbook_Copy()    ' сохраняет копию файла
    ThisWorkbook.SaveCopyAs "e:\Workbook_Backup " & Format(Now, "dd-mmm-yyyy hh-mm-ss") & ".xls"
End Sub

Последний раз редактировалось EducatedFool; 05.07.2009 в 22:41.
vostok вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сохранение книги Excel по названию ячейки и по пути ячейки IFRSoff Microsoft Office Excel 16 07.06.2012 16:58
Сохранение копии книги при ее закрытии. Busine2009 Microsoft Office Excel 17 17.06.2009 04:36
Програмное нажатие на клавиши mustang007 Общие вопросы Delphi 6 24.05.2009 11:40
Сохранение книги большого размера. nemoomen Microsoft Office Excel 12 22.03.2009 05:57
Сохранение книги с интерфейсом. Возможно? smand Microsoft Office Excel 7 06.12.2007 06:05