Часто бывает так, что нет времени (или просто лень) сохранить созданный текстовый документ в нужное место, и пользователь сохраняет его в первое попавшееся место, причем называет его "1111", "123456" и т.д. и т.п.
Для того, чтобы всегда сохранять создаваемые документы только в одно, заведомо заданное место, нужно написать небольшую программу на встроенном языке программирования VBA и разместить ее в шаблоне документов в установленной программе Word.
Сейчас расскажу как она будет работать.
1. Вы создаете новый документ. Редактируете его. После всех правок или при необходимости прервать работу над ним, Вам нужно просто нажать на кнопку в панели быстрого доступа, остальное сделает код VBA.
2. При первом запуске программы, программа создаст на компьютере в папке "Мои документы" новую папку "Переписка", в которой в зависимости от текущей даты создаст следующие папки: "20... год", в ней папку с именем текущего месяца и уже в ней папку с текущей датой. В конечной папке и будет сохранен файл под именем, которое Вы введете в предложенном поле.
3. Плюс такого метода в следующем:
- вы многократно сокращаете время на сохранение файла;
- все файлы лежат только в одной папке "Переписка" и если вы примерно помните дату, когда создавали документ, то вы всегда найдете его в папках;
- вы всегда сможете точно сказать сколько и в какой период подготовили электронных документов.
Недостаток только один: нужно небольшое время на создание кода VBA и настроить кнопку на панели быстрого доступа.
Посмотреть как это работает вживую можно на моем видео.
сам код выглядит так:
Sub ПерепискаПапка()
Dim strPath As String
Dim strPath2 As String
Dim strPathY As String
Dim strName As String
Dim strMonth As String
Dim strM As String
Dim strDay As String
Dim strFolder As String
Dim intM As Integer
Dim myPath As String
Dim FileSys As Object
Dim strPathM As String
Set FileSys = CreateObject("Scripting.FileSystemObject")
Dim dtNow As Date
dtNow = Now
intM = Month(Now)
Select Case intM
Case 1
strM = "января"
Case 2
strM = "февраля"
Case 3
strM = "марта"
Case 4
strM = "апреля"
Case 5
strM = "мая"
Case 6
strM = "июня"
Case 7
strM = "июля"
Case 8
strM = "августа"
Case 9
strM = "сентября"
Case 10
strM = "октября"
Case 11
strM = "ноября"
Case 12
strM = "декабря"
End Select
strMonth = Format(dtNow, "mmmm")
Select Case strMonth
Case "Январь"
strMonth = "1_" & strMonth
Case "Февраль"
strMonth = "2_" & strMonth
Case "Март"
strMonth = "3_" & strMonth
Case "Апрель"
strMonth = "4_" & strMonth
Case "Май"
strMonth = "5_" & strMonth
Case "Июнь"
strMonth = "6_" & strMonth
Case "Июль"
strMonth = "7_" & strMonth
Case "Август"
strMonth = "8_" & strMonth
Case "Сентябрь"
strMonth = "9_" & strMonth
Case "Октябрь"
strMonth = "10_" & strMonth
Case "Ноябрь"
strMonth = "11_" & strMonth
Case "Декабрь"
strMonth = "12_" & strMonth
End Select
strDay = Format(Now, "d")
strFolder = strDay & " " & strM
myPath = VBA.Environ("USERPROFILE") & "\Мои документы"
strPath = myPath & "\Переписка"
strPathY = myPath & "\Переписка\" & Format(Now, "yyyy") & " год"
strPathM = myPath & "\Переписка\" & Format(Now, "yyyy") & " год" & "\" & strMonth
strPath2 = myPath & "\Переписка\" & Format(Now, "yyyy") & " год" & "\" & strMonth & "\" & strFolder
If FileSys.folderexists(strPath) = False Then
MkDir strPath
MkDir strPathY
MkDir strPathM
MkDir strPath2
End If
If FileSys.folderexists(strPathY) = False Then
MkDir strPathY
MkDir strPathM
MkDir strPath2
End If
If FileSys.folderexists(strPath2) = False Then
MkDir strPath2
End If
strName = InputBox("Введите имя файла")
ActiveDocument.SaveAs2 strPath2 & "\" & strName
End Sub
Ставьте лайки и подписывайтесь на канал, если Вам понравилась статья и желаете дальше повышать свои навыки в программировании VBA
