Бэкап открытой книги Excel

@каролинка · Регистрация: 28.10.2012

Студворк — интернет-сервис помощи студентам

Всем привет!
Может кто мне подскажет, как с помощью ВБА сделать бэкап открытой книги эксель. у нас есть файл эксель, мы его открываем, жмем кнопку и создается копия этого файла в указанной папке.

Скрипт · 04.12.2012, 18:13

Visual Basic
1
2
3
4
5
6
7
Sub Макрос1()
    
    Const sPath As String = "C:\Users\User\Desktop\BackUp.xlsx"
    
    ActiveWorkbook.SaveCopyAs sPath
    
End Sub

@каролинка · 04.12.2012, 20:00 **[ТС]**

о, надо проверить

Скрипт, а если мне нужно чтобы в название ставилось имя этого файла_дата_параметр_из_книги?
это возможно вообще?

Скрипт · 04.12.2012, 20:05

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Макрос1()
    
    Dim sPath As String
    
    'Делаем путь файла.
    sPath = ActiveWorkbook.Path & "\"
    
    'Делаем имя файла.
    sPath = sPath & Date & ".xlsx"
    
    'Делаем копию активной книги.
    ActiveWorkbook.SaveCopyAs sPath
    
End Sub

@каролинка · 04.12.2012, 22:09 **[ТС]**

Скрипт, а как еще название добавить к дате?

@Казанский · 04.12.2012, 22:34

Visual Basic
1
2
3
4
5
6
7
8
9
10
Sub bb()
Dim p$, s$, i&
p = ActiveWorkbook.FullName 'полный путь
i = InStrRev(p, ".")        'позиция последней точки (перед расширением)
s = Left(p, i - 1) & "_" & Date & "_" & [A1] & "_" & Mid(p, i)
                            'сформированный новый путь
                            '"параметр_из_книги" - ячейка А1 активного листа
'MsgBox s 'контроль пути сохранения
ActiveWorkbook.SaveCopyAs s
End Sub

@каролинка · 04.12.2012, 22:40 **[ТС]**

Казанский, чтото оно мне какието сообщения выдает и пытается сохранить и закрыть открытую книгу

@Казанский · 04.12.2012, 22:49

Сообщение от каролинка

оно мне какието сообщения выдает

Не догадываетесь - какие, и как это отключить?

Поправил код выше.

@каролинка · 04.12.2012, 23:38 **[ТС]**

уже вроде все ок)

Добавлено через 25 минут
Казанский, а как в вашем коде указать путь к папке?

Памирыч · 05.12.2012, 08:54

Сообщение от каролинка

а как

Пора включаться в процесс и Вам.

@каролинка · 06.12.2012, 16:08 **[ТС]**

В общем, на данный момент код такой вышел

Visual Basic
1
2
3
4
5
6
7
8
     par1 = ThisWorkbook.Worksheets("Parameters").Range("A8").Value
     
p = par1 & ThisWorkbook.Name 
i1 = InStrRev(p, ".")
m = ThisWorkbook.Worksheets("WEEKSHEET").Range("F1").Value
s = Left(p, i1 - 1) & "_" & Date & "_" & [m] & "_" & Mid(p, i1)
                      
ActiveWorkbook.SaveCopyAs s

вопрос: если ли способ проверить ссылку? мы копируем в папку, путь указан в А8. как проверить есть ли такая папка?

Скрипт · 06.12.2012, 17:41

Можно попробовать использовать средство языка программирования VBA - функцию Dir. Но я не понимаю, как с помощью неё узнать: существует папка или нет.

Поэтому предлагаю использование специальной библиотеки для работы с папками и файлами: Windows Script Host Object Model. При использоании этой библиотеки всё ясно и понятно.

Ранняя связка (нужно подлкючить библиотеку: Tools - References... - Windows Script Host Object Model):

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Procedure_3()
 
    'Создаём переменную "oFSO" и объект "FileSystemObject" для работы с папками и файлами.   
    Dim oFSO As New IWshRuntimeLibrary.FileSystemObject
   
    Dim sPath As String
    
    'Здесь нужно указать путь папки.
    sPath = ""
    
    If oFSO.FolderExists(sPath) = False Then
        MsgBox "Папки нет!", vbCritical
        Exit Sub
    End If
 
End Sub

Поздняя связка:

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Procedure_4()
    
    Dim oFSO As Object
    Dim sPath As String
    
    'Здесь нужно указать путь папки.
    sPath = ""
    
    'Создаём объект "FileSystemObject" для работы с папками и файлами.
    Set oFSO = CreateObject(Class:="Scripting.FileSystemObject")
    
    If oFSO.FolderExists(sPath) = False Then
        MsgBox "Папки нет!", vbCritical
        Exit Sub
    End If
 
End Sub

@каролинка · 07.12.2012, 14:00 **[ТС]**

Скрипт, спасибо, все приспособила и работает как надо!)

@каролинка · 12.12.2012, 13:49 **[ТС]**

еще по этой теме вопрос, может кто подскажет
как сделать так, чтобы если второй раз копируем один и тот же файл, то добавлялась единичка к названию, например. как у виндовс с папками: если есть уже новая папка, то создает новая папка(1)

Я пробовала так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
     par1 = ThisWorkbook.Worksheets("Parameters").Range("A8").Value
   
If oFSO.FolderExists(par1) = True Then
          
p = par1 & ThisWorkbook.Name 'iieiue ioou
i1 = InStrRev(p, ".")
 
m = ThisWorkbook.Worksheets("WEEKSHEET").Range("F1").Value
m1 = ThisWorkbook.Worksheets("WEEKSHEET").Range("J1").Value
For q=1 to 10
s = Left(p, i1 - 1) & "_" & [m1] & "_" & q  & "_" & [m] & "_" & Mid(p, i1)
Next q
ActiveWorkbook.SaveCopyAs s

но не получается то, что надо

Скрипт · 12.12.2012, 14:16

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

@каролинка · 13.12.2012, 12:47 **[ТС]**

Скрипт, спасибо, сообразила и заработало

Добавлено через 22 часа 11 минут

Сообщение от Казанский

s = Left(p, i - 1) & "_" & Date & "_" & [A1] & "_" & Mid(p, i)

подскажите как мне избавиться от этого Left , чтобы вместо имени файла брался параметр из листа
я пыталась подставлять так

Visual Basic
1
2
3
4
5
p = par1 & ThisWorkbook.Worksheets("WEEKSHEET").Range("B3").Value
 
i1 = InStrRev(p, ".")
 
s = Left(p, i1 - 1) & "_" & [m] & "_" & Year(ThisWorkbook.Worksheets("WEEKSHEET").Range("W1").Value) & "_" & WorksheetFunction.WeekNum(ThisWorkbook.Worksheets("WEEKSHEET").Range("W1").Value) & "_" & Mid(p, i1)

но так не работает...(

Скрипт · 13.12.2012, 13:13

Visual Basic
1
2
3
4
5
6
7
8
p = par1 & ThisWorkbook.Worksheets("WEEKSHEET").Range("B3").Value
 
i1 = InStrRev(p, ".")
 
s = p & "_" & [m] & "_" & _
    Year(ThisWorkbook.Worksheets("WEEKSHEET").Range("W1").Value) & "_" & _
    WorksheetFunction.WeekNum(ThisWorkbook.Worksheets("WEEKSHEET").Range("W1").Value) & "_" & _
    Mid(p, i1)

@каролинка · 13.12.2012, 14:32 **[ТС]**

Скрипт, спасибо, но оно не хотело работать с ThisWorkbook.Worksheets("WEEKSHEET").Ran ge("B3").Value.
и я сообразила так сделать:

Visual Basic
1
s = par1 & "_" & [m] & "_" & Year(ThisWorkbook.Worksheets("WEEKSHEET").Range("W1").Value) & "_" & WorksheetFunction.WeekNum(ThisWorkbook.Worksheets("WEEKSHEET").Range("W1").Value) & "_" & Mid(p, i1)

где par1- адрес папки был, а m - значение ячейки с фио

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer 8Observer8 08.02.2026 Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .	SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств 8Observer8 07.02.2026 Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .	SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .
SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .	SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152

	Бэкап открытой книги Excel 04.12.2012, 17:32. Показов 6110. Ответов 17 Метки excel, бэкап, книги, открытой (Все метки) Всем привет! Может кто мне подскажет, как с помощью ВБА сделать бэкап открытой книги эксель. у нас есть файл эксель, мы его открываем, жмем кнопку и создается копия этого файла в указанной папке. 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	04.12.2012, 20:00 [ТС]
	о, надо проверить Скрипт, а если мне нужно чтобы в название ставилось имя этого файла_дата_параметр_из_книги? это возможно вообще? 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	04.12.2012, 22:09 [ТС]
	Скрипт, а как еще название добавить к дате? 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	04.12.2012, 22:40 [ТС]
	Казанский, чтото оно мне какието сообщения выдает и пытается сохранить и закрыть открытую книгу 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	04.12.2012, 23:38 [ТС]
	уже вроде все ок) Добавлено через 25 минут Казанский, а как в вашем коде указать путь к папке? 0

@каролинка 0 / 0 / 0 Регистрация: 28.10.2012 Сообщений: 152
	07.12.2012, 14:00 [ТС]
	Скрипт, спасибо, все приспособила и работает как надо!) 0

Скрипт 5472 / 1150 / 50 Регистрация: 15.09.2012 Сообщений: 3,576
	12.12.2012, 14:16
	каролинка, в цикле проверяйте, существует файл с таким именем нет. На каждом витке цикла увеличивайте переменную на единицу. Если не существует, то добавляете полученное число к имени файла. 1