К списку форумов К списку тем
Регистрация    Правила    Главная форума    Поиск   
Имя: Пароль:
Рекомендовать в новости

Уничтожить файл Excel

0 - 06.06.2012 - 10:59
У меня такая задача, может кто поможет решить.
Существует локальная сеть предприятия. На всех компах есть файл таблицы excel с определённой базой данных. Базу обновляю я и через время она расползается по всей сетке по всем компам путём копипаста. Начало работы с файлом начинается с нажатия на кнопку гиперссылки внутри файла. Задача что-то сделать с файлом, чтобы к определённой дате он испортился (удалился, стёрлись, заменились данные, не важно). Не знаю как реализовать этот механизм. Может макрос кто поможет написать, или как то по другому?
Если я не в той теме пишу, укажите правильную. Заранее спасибо.



Гость
1 - 06.06.2012 - 13:03
Как насчет "Rights Management Services"? Он же AD RMS.
Гость
2 - 06.06.2012 - 15:59
Значит-с, так. Если самозачищаемых файлов много - можно сделать их самоуничтожаемыми при открытии в заданный день или отстоящий на N дней, при открытии не там, не тем пользователем, не на том компьютере, не в рабочее время итп - это достаточно легко. Если файло один и очень секретный - то расползающиеся тараканы это плохо - надо работать с файлом ТОЛЬКО на сервере.

Вот идеи:
1) Можно макросом запретить диалог SaveAs "Сохранить как", для 80% юзеров это уже достаточно. Искать в иностранной книге Трюки и эффекты (код выложен на сайте изд-ва)

2) Можно, при открытии книги, неотключаемым в Excel даже по Ctrl+Break автомакросом читать путь, и если путь не-сервер - а) забивать содержимое бессмыслицей б) сохранять в) удалять. Если просто сразу файл удалить методом kill - он почти 100% восстановим, хотя в корзину он не попадает. Это пункт помогает в остальных 19% случаев.

3) Но можно открыть XLS не в Excel, а в OpenOffice/LibreOffice или пересохранить его в XLSX идр "немакросные" форматы. И автомакрос при этом не сработает. Поэтому нужна подстраховка - Разрешить открывать только в Excel, путем стойкого "несовместимого" шифрования.
...
Макроссы может здесь наваять, а Вопросы по RMS лучше задавать на форуме "Сети".
3 - 09.06.2012 - 11:21
2-economist >А можешь написать макрос в этом файле если кину по почте?
Гость
4 - 11.06.2012 - 23:10
Могу - какой именно вариант идеи? Я введу в макросе условное имя и/или IP адрес сервера. Надо будет после размещения у себя на серваке закомментировать нужные строки кода и проверить работоспособность в случае переписывания на другую машину. В принципе, мне не нужен ваш секретный файл, но имя его мне понадобится, если оно слишком специфично - переименуйте попроще. Тогда в мой файл достаточно будет переместить листы из вашего, пересохранить с заменой - и вуаля...
Гость
5 - 13.06.2012 - 08:33
'----------------------------------------------
Private Sub Workbook_Open()
' (c) economist Все как есть - без гарантий!
' Макрос в книге при открытии файла читает имя компа и сравнивает его с РАЗРЕШЕННЫМ
' и если совпадения нет - "самоуничтожается" путем перезаписи с пустым содержимым всех листов
' Макрос вставить в после Alt+F11 в объект ЭтаКнига
' Проверить на пустом файле, введя бессмылице в ячейки листов, убедиться что после открытия НЕ на сервере ячейки очистились
' затем уже сделать на рабочем (можно путем переноса листов вручную)
' Если неизвестно имя компьютера-сервера - узнать у сисадмина!


Dim legalServer As String
Dim HostName As String
legalServer = "SERVERNAMEUPPERCASE" ' ВВЕДИТЕ разрешенный сервер, на котором файл живет (в верх регистре)
HostName = CreateObject("WScript.Network").ComputerName ' узнали имя компа

If legalServer <> HostName Then ' если сервер нелегален, то
Dim sh As Object
For Each sh In ThisWorkbook.Sheets
sh.Cells.ClearContents
Next sh
ThisWorkbook.Save
End If
End Sub
Гость
6 - 13.06.2012 - 08:39
Можно отследить имя сервера и по его IP-адресу, но если в он "динамически" выдается - будут некоторые сложности в реализации (придется лезть в кущеряки, типа оснасток WMI, а там высока вероятность что злой админ запретил их). Кстати, Макрос не заработает если у вас админ запретил и Wscript. Тогда надо ему какбэ намекнуть что он не прав, и его параною можно вылечить...
7 - 13.06.2012 - 15:21
Автор, побольше бы исходных данных.
Цитата:
Сообщение от Рюкзак Посмотреть сообщение
определённой базой данных
Из таблиц есть прямая связка к БД?
Цитата:
Сообщение от Рюкзак Посмотреть сообщение
Базу обновляю я
Способ обновления? Простое копирование?

В организации есть какие-либо домены и прочее?
Можно сделать скрипт, который при первом запуске будет осуществлять поиск файлов с каким либо признаком (можно даже по содержимому файла, например содержимому гиперсылки) и удалять подобные файлы. Ну или какой-то подобный механизм.
А еще лучше посмотреть в сторону оптимизации предоставления информации пользователям.
Гость
8 - 13.06.2012 - 16:15
+5: Я вот тут поразмыслил - в мой макрос нужно добавить вот еще что - чтение/сравнение пути самой книги XLS. Иначе файл будет самоочищаться при любом доступе извне. Завтра допишу.
Гость
9 - 13.06.2012 - 17:49
Постановка задачи неверная и попадает под статью УК. Так что правильный подход в этом случае следующий где то на своем сервере разместить такие "ценные" данные, а пользователям предоставлять доступ к ним по сети через клиентское приложение или web интерфейс. Использовать нормальную клиент-серверную БД, а не страдать фигней с excel файлом. Доступ для пользователей сделать платным т.е. заплатил - получил логин и пароль действительный в течении определенного времени, о чем пользователь должен быть уведомлен. Естественно можно сделать контроль чтобы под одним логином не лезло несколько особо хитрых пользователей.
Гость
10 - 14.06.2012 - 05:12
Если закрыт Wscript можно использовать такой код

Private Declare Function GetComputerNameA Lib "kernel32" _
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function WNetGetUserA Lib "mpr.dll" _
(ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Function GetComputerName() As String
Dim sBuffer As String * 255
If GetComputerNameA(sBuffer, 255&) <> 0 Then
GetComputerName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
End Function
Function GetUserName() As String
Dim sUserNameBuff As String * 255
sUserNameBuff = Space(255)
Call WNetGetUserA(vbNullString, sUserNameBuff, 255&)
GetUserName = Left$(sUserNameBuff, InStr(sUserNameBuff, vbNullChar) - 1)
End Function
Гость
11 - 14.06.2012 - 09:11
Вот исправленный макрос под задачи автора - грохать открытое не там.

Private Sub Workbook_Open()
' (c) economist. Как есть - без гарантий!
' ************************************************** ************************************************** *********************************
' ******* Самоудалялка XLS-VBA, если открыли файл не там где можно *****
' ************************************************** ************************************************** *********************************
' Макрос в книге при открытии файла XLS определяет ГДЕ находится сам XLS-
' файл, с поддержкой всех видов путей (буквы диска, LAN, UNC)
' и если не там где РАЗРЕШЕНО - "самоуничтожается" путем перезаписи с
' пустым содержимым всех листов. Задать легальный сервер (имя, IP)!
' Макрос вставить в после Alt+F11 в объект ЭтаКнига
' Проверить на пустом файле, введя бессмылицу в ячейки листов, убедиться что после открытия НЕ на сервере ячейки очистились
' затем уже сделать на рабочем (можно путем переноса листов вручную)
' Если неизвестно имя/IP компьютера-сервера - узнать у сисадмина!
' TODO: Если сеть одноранговая с дин.-IP - подумать

Dim legalServerIP As String ' создали перем для IP "разрешенного" сервера XLS
Dim legalServer As String ' создали перем для имени "разрешенного" сервера XLS
Dim NetPath, RealPath ' создали перем для IP адреса компа, с которого реально открыт файл XLS
Dim fso As New Scripting.FileSystemObject ' создали перем для файловых объектов
Dim sh As Object ' премененная для затирания листов

legalServerIP = "10.0.0.10" ' ВВЕДИТЕ IP - адрес разрешенного сервера XLS, на котором файл живет (в верх регистре)
legalServer = "Server1" ' ВВЕДИТЕ DNS-имя разрешенного сервера XLS (первая буква обычно большая)
DriveXLS = Left(ThisWorkbook.Path, 1) ' прочли имя диска (м.б. сетевого), если открыли через сеть - \
NetPath = Split(ThisWorkbook.Path, "\") ' разбили путь на части

' Файл в Windows можно открыть по разному:
' А - C локального диска (с любой буквой)
' Б - С сетевого диск (с любой буквой)
' В - Через UNC - то есть \\server1\folder\filename.xls
' Г - или без DNS имен - то есть \\XXX.XXX.XXX.XXX\folder\filename.xls
' Поэтому в программе будет ветвление - первый символ - диск или \

' Для \\server1\folder\filename.xls и \\10.0.0.100\folder\filename.xls
If DriveXLS = "\" Then ' если вдруг открыли файл через сетевое окружение
RealPath = NetPath(2) ' прочли ИМЯ сервера server1
If (legalServer <> RealPath And legalServerIP <> RealPath) Then
For Each sh In ThisWorkbook.Sheets
sh.Cells.ClearContents
Next sh
ThisWorkbook.Save
End If
End ' закончили случай с \\server и \\XXX.XXX.XXX.XXX
End If

' Для локальных дисков С:-F: и сетевых G:-Z: (к примеру) C:\folder\filename.xls и G:\folder\filename.xls
If DriveXLS <> "\" Then ' если это буква диска
NetPath = Split(fso.Drives(DriveXLS).ShareName, "\")
On Error Resume Next '
RealPath = NetPath(2) ' прочли ИМЯ сервера server1

If (legalServer <> RealPath And legalServerIP <> RealPath) Then
For Each sh In ThisWorkbook.Sheets
sh.Cells.ClearContents
Next sh
ThisWorkbook.Save
End If
On Error GoTo 0
End If ' закончили случай с буквами диска
End Sub
Гость
12 - 14.06.2012 - 09:13
Очень форуму не хватает подсветки кода, или хотя бы моноширинности. В моей вики просто глаз радуется от "цветника", здесь же - как будто школьник напЫсал...
Гость
13 - 14.06.2012 - 12:55
Рюкзак - замечу также, что работа с XLS с самих рабочих станций предполагается прямо на сервере, а не борьба с уже расползшимися тараканами по сети.
...
Тут Naix и TVV1 говорят что инструментарий (Excel) неподходящий - вполне возможно. Но есть хорошие примеры одновременной(!) работы в одном(!) файле Excel 3-5 активных пользователей (с парольной защитой, журналированием/откатом изменений) и это не просто "туповвод", а работа с развернутыми формами, справочниками (все сделано на формулах/диапазонах), и реализовать такое на СУБД+морде выйдет на несколько месяцев и сотню+две тысяч рублей ЗП с налогами дороже, чем просто самоуничтожалка, быстро приучающая юзверей работать с сетевой шарой.

Для полнофункционального решения в Excel еще надо бы:

а) написать перехватчик Ctrl+Break (чтобы не остановить макрос) (легко гуглится)

б) заблокировать кодом SaveAs (легко гуглится)

в) стойко запаролить файл и сам модуль (разными паролями)

г) предупредить юзера модальным окном, чтобы он не пытался сделать копии с файла

д) заблокировать на время работы макроса прорисовку интерфейса (Application.ScreenUpdating=False), а то юзер увидит как его циферки быстренько исчезают. Впрочем, педагогический эффект внушаиитттьь...
Гость
14 - 14.06.2012 - 13:25
з) Вспомнил еще, что если в Excel отключить заблокировать макросы, то файл откроется не очистившись. Но на каждую жп найдется и лерка и метчик. Добавить так:


Dim sh As Object ' переменная для затирания листов

' сильно скрыть листы 1-2 (последний должен быть видимым, если что - добавить ручками)
' такое скрытие в Excel без макроса не раскрыть
ThisWorkbook.Sheets(1).Visible = xlSheetVeryHidden
ThisWorkbook.Sheets(2).Visible = xlSheetVeryHidden



а далее после каждого ThisWorkbook.Save добавить

ThisWorkbook.Save
ThisWorkbook.Sheets(1).Visible = True
ThisWorkbook.Sheets(2).Visible = True

PS Данные из ячеек скрытого листа, зная пароль все равно можно прочитать безо всякого программирования, просто отобразив их формулами, ссылающимися на книгу/лист/ячейку, но 99% юзверей об этом трюке не знают. К тому же можно их сделать неактуальными/неправильными по какому-нить алгоритму.
Гость
15 - 16.06.2012 - 10:46
' (c) economist. Как есть - без гарантий!
' ******* Самоудалялка XLS-VBA, если открыли файл не там где можно *****
' Макрос в книге при открытии файла XLS определяет ГДЕ находится сам XLS-
' файл, с поддержкой всех видов путей (буквы диска, LAN, UNC)
' и если не там где РАЗРЕШЕНО - "самоуничтожается" путем перезаписи с
' пустым содержимым всех листов. Задать легальный сервер (имя, IP)!
' Макрос вставить в после Alt+F11 в объект ЭтаКнига
' Проверить на пустом файле, введя бессмылицу в ячейки листов, убедиться что после открытия НЕ на сервере ячейки очистились
' затем уже сделать на рабочем (можно путем переноса листов вручную)
' Если неизвестно имя/IP компьютера-сервера - узнать у сисадмина!
' TODO: Если сеть одноранговая с дин.-IP - подумать

' (с) daxy. Расширение функционала
' Отключено сохранение книги Файл-Сохранить как
' Теперь работаем со всеми листами книги
' При загрузке книги без макросов не отображаются листы с данными, а отображается лист с приветствием.

Option Explicit
Const legalServerIP As String = "10.0.0.10" ' ВВЕДИТЕ IP - адрес разрешенного сервера XLS, на котором файл живет (в верх регистре)
Const legalServer As String = "Server1" ' ВВЕДИТЕ DNS-имя разрешенного сервера XLS (первая буква обычно большая)
Const PR As String = "ВКЛЮЧИТЕ МАКРОСЫ!" ' ИМЯ КНИГИ НАПОМИНАЛКИ
Dim sh As Object
Dim fso As Object

Private Sub Valid_Server()
' Файл в Windows можно открыть по разному:
' А - C локального диска (с любой буквой)
' Б - С сетевого диск (с любой буквой)
' В - Через UNC - то есть \\server1\folder\filename.xls
' Г - или без DNS имен - то есть \\XXX.XXX.XXX.XXX\folder\filename.xls
' Поэтому в программе будет ветвление - первый символ - диск или \
' Для \\server1\folder\filename.xls и \\10.0.0.100\folder\filename.xls
Set fso = CreateObject("Scripting.FileSystemObject") 'в отличии от Dim fso As New Scripting.FileSystemObject не требует включения референсов в библу VBA
Dim NetPath, RealPath, DriveXLS As Variant ' создали перем для IP адреса компа, с которого реально открыт файл XLS
DriveXLS = Left(ThisWorkbook.Path, 1) ' прочли имя диска (м.б. сетевого), если открыли через сеть - \
NetPath = Split(ThisWorkbook.Path, "\") ' разбили путь на части
On Error Resume Next
If DriveXLS = "\" Then ' открыли файл через сетевое окружение
RealPath = NetPath(2) ' прочли ИМЯ сервера server1
If (legalServer <> RealPath Or legalServerIP <> RealPath) Then Kill_And_Save 'была видимо ошибка, не И а ИЛИ надо но не утверждаю
Else 'Открыли файл с буквами диска
NetPath = Split(fso.Drives(DriveXLS).ShareName, "\")
RealPath = NetPath(2) ' прочли ИМЯ сервера server1
If (legalServer <> RealPath Or legalServerIP <> RealPath) Then Kill_And_Save
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Workbook_Save
Cancel = True
End Sub

Private Sub Workbook_Save()
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
WorkSheets_VeryHidden
ThisWorkbook.Save
WorkSheets_Visible
DeletePR
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub WorkSheets_Visible()
For Each sh In ThisWorkbook.Sheets
ThisWorkbook.Sheets(sh.Name).Visible = True
Next sh
DeletePR
End Sub

Private Sub WorkSheets_VeryHidden()
AddPR
For Each sh In ThisWorkbook.Sheets
If sh.Name <> PR Then ThisWorkbook.Sheets(sh.Name).Visible = xlSheetVeryHidden
Next sh
End Sub
Private Sub AddPR()
DeletePR
Sheets.Add
Sheets(ActiveSheet.Name).Name = PR
Sheets(PR).Tab.Color = vbRed
Range("A2") = "ВКЛЮЧИТЕ МАКРОСЫ!"
Range("A1", "K3").Select
Selection.Interior.Color = vbRed
Selection.Font.Size = 48
End Sub
Private Sub DeletePR()
On Error Resume Next
Application.DisplayAlerts = False
Sheets(PR).Delete
Application.DisplayAlerts = True
End Sub
Private Sub Kill_And_Save()
If MsgBox("Обнаружен не разрешенный носитель для этой книги" & vbCr & "Удалить данные на листах?", vbYesNo) = vbNo Then Exit Sub 'Чтобы не удалить данные при проверке, в реальной работе строчку удалить
For Each sh In ThisWorkbook.Sheets
sh.Cells.ClearContents 'ClearContents оставляет примечание и прочее
Next sh
Workbook_Save
End Sub

Private Sub Workbook_Open()
Application.ScreenUpdating = False
WorkSheets_Visible
Application.ScreenUpdating = True
Valid_Server
End Sub
Гость
16 - 16.06.2012 - 19:06
dax - отлично! VBA способен в офисе изменить сам характер труда, а каждый "шкодер" должен поощряться за любую инициативу! Как работодатель я этому следую издавна, но на пути автоматизации много бревен в глазах и роялей в кустах...
17 - 21.06.2012 - 20:16
Ахи....ть!!!! :О Куда это всё вставлять?!
18 - 21.06.2012 - 20:43
Я понял что я далёк от слова макрос. Люди, всё на много проще!!! Бся база данных состоит из кучи вордовских файлов лежащих в папке на которые простые гиперссылки из файла эксель. Никакими мудрёными эскюэлями и даже аксесами там не пахнет. Эту всю хрень пользуясь своими мягко говоря скудными знаниями экселя и паинтбраша:) слепил я и никакие статьи мне за удаление не грозят. Просто наши начальники нашли это очень удобным и все работники пользуются базой которую я создал фактически для себя. А вот со мной хотят поступить очень не честно. За то что я отказался идти на корпоратив, а главное сдавать деньги на это началась на меня травля. Было бы за дело ёптать! В общем хочу если меня уволят позлорадствовать.
Суть вот в чём. Все работники никакие не програмисты и от слоб БазаДанных падают в обморок. Так что самая простая и глупая подлянка вряд ли будет замечена и должна сработать. Хочу сделать так, чтоб в какой нибудь клеточке экселя белыми чернилами на белом фоне (ну чтоб не видно было) стояла дата порчи этого файла. По умолчанию стоял какой нибудь 31.12.2100. Но если меня увольняют, я туда вписываю дату эдак через месяцок после сегодня, сохраняю. Со временем файл расползается по всем компам и в указанную дату ТРАХ!!!! ))))) Привет от меня! Файл вылодил тут:

http://depositfiles.com/files/kodt4603c
Гость
19 - 21.06.2012 - 23:28
to18
Если ты слепил это в рабочее время и за это получал зарплату и использовал для этого свое рабочее место, то вопрос очень спорный
Потом то что ты описал попадает даже не под одну статью, а под несколько
http://www.zakonrf.info/uk/272/
http://www.zakonrf.info/uk/273/
Гость
20 - 21.06.2012 - 23:35
to18 И еще вопрос как ты думаешь куда денется макрос из xls файла и сколько потребуется времени в случае разбора полетов для выявления причины исчезновения данных.
Гость
21 - 22.06.2012 - 07:28
Рюкзак - прямо какие-то "Заметки отечественного западлостроения" :-))

В терминологии программистов это называется "закладка". Довольно распространенный прием, "страховка" на случай неплатежа/увольнения. За рубежом считается очень дурным тоном, но там и реалии несколько другие.
...
А ваша причина конфликта настолько смешна, что огород городить не советую и помогать не буду. Ходить или нет на корпоратив - дело каждого, и вы это право подтвердили, в другой раз травить не будут. Лучше вашу злость конвертировать в упорство, направить его на обучение, изучить макросы и написать такое полезное для конторы приложение, что вас будут на корпоративы возить/кормить/поить бесплатно. Вот тогда и "закладка" будет уместна, а сейчас - несерьезно.
...
TVV1 - в Excel нет ничего невозможного. Есть как минимум 2 способа.

1) Если включено доверие к объектной модели VBA - любой модуль VBA можно удалить самим VBA по волшебной команде:

Application.ThisWorkbook.VBProject.VBComponents.Re move Application.ThisWorkbook.VBProject.VBComponents.It em("Module1")

Сила это команды настолько велика, что она может убить даже тот модуль, в котором сама находится!

2) Макрос может самоуничтожиться вместе с самим XLS-файлом. В коде VBA создаем BAT-файл вида ..del base.xls, запускаем его и закрываем excel. Батник срабатывает и... Все: ни файла, ни макроса. Корзина тоже пуста. Хотя правильнее сначала перезаписать файл бессмыслицей того же объема, тогда поиски ни к чему не приведут.
Гость
22 - 22.06.2012 - 07:31
В п. 21 в коде вкрались пробелы:
Application.ThisWorkbook.VBProject.VBComponents.Re move_
Application.ThisWorkbook.VBProject.VBComponents.It em("Module1")
...
Если модулей несколько - то циклом, или перебором коллекции (особенно при нестандартных именах или коде в объектах - листах, Workbook итд).
23 - 22.06.2012 - 09:12
19-TVV1 >Не в рабочее! Дома составил. И мне за это ничегошеньки не платили, так что думаю не попадаю. А по поводу макроса, ну вычислят, ну поймут, ну и что? Я ничего никому не обещал и к этому времени буду уволен.21-economist > мне тоже очень смешно что меня за такую фигню до увольнения доводят ((((
Гость
24 - 25.06.2012 - 14:09
23 У нас такое было. Дамочка удалила все свои наработки и уничтожила все отчеты на бумажных носителях перед увольнением. Бегали по ментовкам, писали какие-то бумажки, 70 тыщ. на лапу адвокату и следователю давали, а наказать злодейку так и не смогли.
Гость
25 - 25.06.2012 - 15:29
Рюкзак, запомни самое главное правило:
Хорошо всегда там, где нас нет.
Так что... если тебя хотят "слить" - используй свою контору как средство поиска работы, согласись и возьми рекомендательное письмо, и флаг тебе в руки.
...но сдаётся мне ты лукавишь. Ни разу не видел такого, чтобы человека сливали из-за того что не пошел на корпоратив.
Гость
26 - 03.03.2015 - 07:27
Не может быть-)


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

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




Copyright ©, Все права защищены