Общая папка для обмена документами в офисе (автоматизация очистки)

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

Что делает скрипт:

  • Удаляет все файлы в папке, кроме заданных исключений.
  • Складывает все удаленное в отдельную папку (назовем ее «архив»), озаглавленную датой, когда произведено удаление. Так чтоб потом можно было понять что там было удалено в этот день.
  • Чистит архив, оставляя там заданное количество папок.

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

Сам скрипт на VB (сохраняем его например в файл «obmen.vbs»):

'===============чистка папки обмена =============
'файлы и папки переносятся в скрытую папку deleted
'============================================
pObmen = "d:\OBMEN" 'устанавливаем местонахождение папки обмена
pBackup = "D:\BACKUP\deleted\" + fixDate(Date, "yyyy-mm-dd") 'в эту папку будет выполнено перемещение
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set oObmen = fso.GetFolder(pObmen)
'создаем папку, куда будем перемещать
If (Not fso.FolderExists(pBackup)) then
 Set oBackup = fso.CreateFolder(pBackup)
Else
 Set oBackup = fso.GetFolder(pBackup)
End if
'Перемещаем все папки и файлы из обменника в созданную папку
For Each oFolder In oObmen.Subfolders
 if (oFolder.Name<>"Информация") and (oFolder.Name<>"Порядки и положения") and (oFolder.Name<>"Прайсы") then
 oFolder.Move oBackup.Path & "\"
 End If
Next
For Each oFile In oObmen.Files
 if (oFile.Name<>"desktop.ini") then
 oFile.Move oBackup.Path & "\"
 End If
Next
'удаление устаревших папок (число показывает сколько папок оставить)
For i = 15 to 100
 pBackup = pObmen + "\deleted\" + fixDate(Date-i, "yyyy-mm-dd") 'в эту папку будет выполнено перемещение
 If (fso.FolderExists(pBackup)) then
 fso.DeleteFolder pBackup
 End if 
Next
'===================================================================================================================================
'процедура преобразования формата даты
 ' Use: fixDate(valid date string, format string)
Public Function fixDate(strDate,format)

 d = DatePart("D",strDate)
 m = DatePart("M",strDate)
 y = DatePart("YYYY",strDate)

 if len(d) < 2 then
 d = "0" & d
 end if

 if len(m) < 2 then
 m = "0" & m
 end if
 Select Case Format
 Case "yyyy/mm/dd"
 fixDate = y & "/" & m & "/" & d
 Case "yy/mm/dd"
 fixDate = right(y,2) & "/" & m & "/" & d
 Case "dd/mm/yy"
 fixDate = d & "/" & m & "/" & right(y,2)
 Case "dd/mm/yyyy"
 fixDate = d & "/" & m & "/" & y
 Case "yyyy-mm-dd"
 fixDate = y & "-" & m & "-" & d
 Case "yy-mm-dd"
 fixDate = right(y,2) & "-" & m & "-" & d
 Case "dd-mm-yy"
 fixDate = d & "-" & m & "-" & right(y,2)
 Case "dd-mm-yyyy"
 fixDate = d & "-" & m & "-" & y
 Case "ddmmyyyy"
 fixDate = d & m & y
 Case "ddmmyy"
 fixDate = d & m & right(y,2)
 Case "mmddyy"
 fixDate = m & d & right(y,2)
 Case "mmddyyyy"
 fixDate = m & d & y
 Case "yyyymmdd"
 fixDate = y & m & d
 Case "yymmdd"
 fixDate = right(y,2) & m & d
 Case "yyyy"
 fixDate = y
 Case "Short"
 fixDate = formatdatetime(strDate,vbShortDate)
 Case "Long"
 fixDate = formatdatetime(strDate,vbLongDate)
 Case "dd-Month-yyyy"
 m = MonthName (m,True)
 fixDate = d & "-" & m & "-" & y
 Case "dd-Month-yy"
 m = MonthName (m,True)
 fixDate = d & "-" & m & "-" & right(y,2)
 Case "DayName"
 fixDate = WeekDayName(Weekday(strDate),False)
 Case "DayNameAbbr"
 fixDate = WeekDayName(Weekday(strDate),True)
 Case "SiteDate"
 fixDate = WeekDayName(Weekday(strDate),False) & ", " & DateSuffix(DatePart("D",strDate)) & " of " & MonthName(m,false) & ", " & fixDate(strDate,"yyyy")
 Case "Stamp"
 fixDate = fixdate(Now(),"yyyymmdd") & fixTime(Now(),"Stamp")
 Case Else
 fixDate = d & "/" & m & "/" & y
 End Select

 End Function

 Private Function DateSuffix(num)

 Dim x

 if num < 13 or num > 20 then
 Select Case right(num,1)
 Case "0"
 x = "th"
 Case "1"
 x = "st"
 Case "2"
 x = "nd"
 Case "3"
 x = "rd"
 Case else
 x = "th"
 End Select
 End if

 If num > 12 and num < 21 then
 x = "th"
 End If

 DateSuffix = num & x 

 End Function

 Public Function fixTime(strTime,format)
 h = Hour(strTime)
 m = Minute(strTime)
 s = Second(strTime)

 if s < 10 then 
 s = "0" & s
 end if

 if m < 10 then
 m = "0" & m
 end if

 if h < 10 then 
 h = "0" & h
 end if

 Select Case format
 Case "hh:mm:ss"
 fixTime = h & ":" & m & ":" & s
 Case "hhmmss"
 fixTime = h & m & s
 Case "Stamp"
 fixTime = h & m & s
 Case Else
 fixTime = formatdatetime(strTime,vbShortTime)
 End Select

 End Function
Запись опубликована в рубрике Без рубрики. Добавьте в закладки постоянную ссылку.

Один комментарий: Общая папка для обмена документами в офисе (автоматизация очистки)

  1. Игорь говорит:

    Действительно очень удобный скрипт, который позволяет сэкономить кучу времени, для очистки компьютера. На своём опыте знаю, что обычно на подобных файлопомойках накапливается огромное количество ненужной информации, которую рано или поздно приходиться чистить системному администратору. Возникает закономерный вопрос — зачем тратить на этот процесс уйму времени, если его можно автоматизировать с помощью данного скрипта. Имел подобную проблему, тогда у нас при обмене документами, на подобных папках, также скапливалось много ненужной информации, которую приходилось время от времени чистить.

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *