Макрос VBA: путем противопоставления книге Excel (файлу) автоматическое сохранение копии в определенной папке - PullRequest
Новая
       44

Макрос VBA: путем противопоставления книге Excel (файлу) автоматическое сохранение копии в определенной папке

0 голосов
/ 03 ноября 2019

Может ли кто-нибудь помочь мне с макросом, который должен: противопоставляя рабочую книгу (файл) Excel автоматически сохранять ее копию в определенной папке?

У меня есть рабочая книга Excel, которая используется многимилюдей и может быть легко разрушен. Было бы неплохо иметь копию этого файла всегда, когда кто-то открывает его. Книга Excel находится в sharepoint, поэтому я могу создать новую папку в том же месте с именем «Архив» и, открыв файл, новую копию этого файла с тем же именем + «ДД.ММ.ГГГ ЧЧ: ММ: СС"будут сохранены здесь.

Заранее спасибо

1 Ответ

0 голосов
/ 03 ноября 2019

Я не уверен насчет sharepoint, но это работает, если файл сохраняется в обычной папке. Решение может быть принято разными способами.

Сохраните код в следующем месте в редакторе VBA. Назовите подпункт «Private Sub Workbook_Open()» - чтобы указать, что Excel должен выполнить код при его открытии. Вы можете видеть, что вы добились успеха, когда поле «процедура» меняется на «Открыть», помеченное на рисунке желтым цветом. enter image description here

Альтернатива 1:

Здесь я жестко закодировал свой путь, написав "G:\Till\". Затем я продолжаю добавлять метку времени и выбираю, какой формат. Обратите внимание на то, что вы не можете использовать точку с запятой":" в пути. Одним из способов является добавление «T» для времени, а затем час + минута + секунда. В моем примере кода результат будет: «Пример данных - 2019-11-03 T203533.xlsm»

Обратите внимание, что этот код получит ошибку 1004, если путь не существует. 

Private Sub Workbook_Open()
Dim Fldr As String
Application.DisplayAlerts = False 'Hide any save window pop-up
ActiveWorkbook.SaveCopyAs Filename:="G:\Till\" & "Data Example - " & Format(Now(), "yyyy-MM-dd Thhmmss") & ".xlsm" 'Save the workbook as a copy of the original. Add Hour and timestamp
Application.DisplayAlerts = True
End Sub

Альтернатива 2:

Чтобы сделать код более надежным, я проверяю путь к используемой книге, а затем проверяю, существует ли папка «Архив». Если он не существует, он создаст папку и сохранит копию файла. 

Private Sub Workbook_Open()
Dim Fldr As String
Application.DisplayAlerts = False 'Hide any save window pop-up
Fldr = Dir(Application.ActiveWorkbook.Path & "\Archive\", vbDirectory) 'Check if folder exists. The variable will be empty if no folder exists.

If Fldr = Empty Then 'If no folder exist, the variable "Folder"
    MkDir Application.ActiveWorkbook.Path & "\Archive\" 'Create the folder
End If

ActiveWorkbook.SaveCopyAs Filename:=Application.ActiveWorkbook.Path & "\Archive\" & "Data Example - " & Format(Now(), "yyyy-MM-dd Thhmmss") & ".xlsm"
Application.DisplayAlerts = True
End Sub
...