Vba excel кто открыл файл

 

angelrr

Пользователь

Сообщений: 62
Регистрация: 01.01.1970

А я пользуюсь во всех книгах следующим макросом. Реально не раз выручал, когда пользователь говорит «не я», а я ему показываю что всетаки он.  
Отображает в листе «Log» кто, что, и когда сделал.  

  Sub LogFilling(ByVal Target As Range, ByVal SheetName As String)  

               Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 1).NumberFormat = «dd.mm.yyyy hh:mm:ss»  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 1).HorizontalAlignment = xlRight  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 1).Value = Date + Time  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 2).NumberFormat = «@»  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 2).HorizontalAlignment = xlRight  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 2).Value = SheetName & «: » & Target.Address  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 3).HorizontalAlignment = xlRight  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 3).Value = Application.UserName  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 4).HorizontalAlignment = xlRight  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 4).Value = _  
                                               Worksheets(«Log»).Cells(1, 12).Value  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 5).HorizontalAlignment = xlRight  
   Worksheets(«Log»).Cells(Worksheets(«Log»).Cells(1, 11).Value, 5).Value = Target.Value  
   Worksheets(«Log»).Cells(1, 11).Value = Worksheets(«Log»).Cells(1, 11).Value + 1  

             End Sub

Источник
  • Remove From My Forums

  • Вопрос

  • в VBScript пытаюсь создать подключение к excel файлу. но эта книга лежит на сервере, иногда эта книга бывает занята другим пользователем. как
    я могу получить имя пользователя  кто занял данную таблицу? уведомление во вложении. Имя пользователя как зарегистрирован в office

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

Источник

как определить компьютер, с которого открыли файл?

Автор Стасон, 30.10.2009, 15:45

« назад — далее »

Можно ли средствами VBA узнать сетевое имя компьютера, с которого открыли «для записи» необщий файл, который я вынужден открыть позже уже «только для чтения»?

Вот так попробуйте:

Private Declare Function GetComputerName Lib «kernel32» Alias «GetComputerNameA» (ByVal lpBuffer As String, nSize As Long) As Long

Sub test()
Dim scomp As String
scomp = Space(255)
h = GetComputerName(scomp, 255)
MsgBox Trim(scomp)
End Sub

Спасибо. Попробовал. Однако, я получаю своё имя. Мне же надо узнать кто из сети открыл файл.
Или я не так это использую?

Эта процедура выдает имя того, кто в настоящий момент открыл файл. Если Вы открыли, то Ваше имя и выдаст. Если кто другой — соответственно — его имя. Как Вы организуете использование этой информации — тут простор для фантазии. Можно, например, поставить процедуру в автозапуск по событию открытия файла и вместо мессаджбокса записывать ее в определенную ячейку, или в пользовательское свойство файла, или сообщать кому следует :), например по почте.

Путей к вершине — множество. Этот один из многих!

Цитата: Алексей Шмуйлович от 02.11.2009, 20:42
Эта процедура выдает имя того, кто в настоящий момент открыл файл. 

Дык, этот файл в настоящее время открыли двое. «Тот, кто открыл первым»  и я.
Эта процедура определяет только имя копьютера, с которого я открыл файл? А определить имя компьютера «того, кто открыл первым» как можно с моего компьютера?
Вариант записи имя компа в именованную константу в книге при первом (по очереди) открытии — это я уже взял на вооружение. Но для этого надо в каждую книгу соответствующий макрос записывать. А хотелось более гибкого и универсального решения.  :'(

Имя пользователя, который открыл файл для работы, Excel же определяет и пишет в мессаге, что-то типа «Файл открыт пользователем User». Неужели это нельзя реализовать силами VBA? :-((((

#7




03.11.2009, 14:36

Последнее редактирование: 03.11.2009, 14:38 от Алексей Шмуйлович

Так, сразу много вопросов.
GWolf, на счет почты я пошутил. Задача в принципе решаемая, но я сам никогда целью не задавался и не решал. И, кажется, была подобная тема про электропочту. Если актуально, давайте вынесем в отдельный топик.
Стасон, я предлагаю схему фиксации где-то на внешнем носителе (на экране, в файле, в базе данных и т.п.) того события что файл открыли. А Вы, видимо хотите понять, кем он открыт в данный момент, т.е. на момент запроса. Как это сделать программно, пока мыслей нет. Руками можно посмотреть в управлении системой с того компьютера, на котором физически хранится файл. Но Вы подумайте хорошо, может для Вашей задачи будет достаточно информации об очереди пользователей, открывавших файл?
Второй вопрос про VBA — не понял. А я же и пишу Вам код на VBA, просто обращаюсь в API. Вы же просили не пользователя, а имя компьютера. Если пользователя, то можно попытаться обратиться к данным подписи пользователя Office, той, что используется при рецензировании, — где-то в настройках программы они есть, соответствнно должен быть и программный доступ к этим данным.

Задумка была такая:
на фирме нет строгой политики по именам пользователя, но зато имена компьютеров уникальны. Поэтому когда открываешь какой-либо файл, а там сидит какой-нибудь «User», то узнать имя компа, с которого этот файл в текущий момент открыт. Дальше уже можно банальным телефонным звонком выгнать пользователя из файла. Вот…

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

Цитата: Стасон от 03.11.2009, 13:53
Имя пользователя, который открыл файл для работы, Excel же определяет и пишет в мессаге, что-то типа «Файл открыт пользователем User». Неужели это нельзя реализовать силами VBA? :-((((

столкнулся с таким у себя на работе. решается очень просто. админ один раз проходится по всем компам и меняет в настройках офиса defaultный USER на имя пользователя, или имя ПК. И все, при открытии открытого файла имеем информацию кто его открыл

Цитата: Алексей Шмуйлович от 03.11.2009, 14:36
…
GWolf, на счет почты я пошутил. Задача в принципе решаемая, но я сам никогда целью не задавался и не решал. И, кажется, была подобная тема про электропочту. Если актуально, давайте вынесем в отдельный топик.

Думаю, что актуально, буду признателен, если все же сможем «дожать» до рабочего кода.

Путей к вершине — множество. Этот один из многих!

Если отправить почту нужно полностью автоматически, то нужны какие-нибудь нестандартные библиотеки. У меня на работе что-то подобное прораммист делал из SQL Servera. При поступлении новых записей в базу срабатывает триггер и мне отправляется письмо. Надо спросить, как он это сделал.
А если достаточно сформировать письмо в Outlook, которое потом человек своей рукой отправит адресату, то это просто. Outlook через OLE вызываем и вперед. Тоже поискать нужно, у меня где-то было.
Какой вариант смотрим?

Цитата: Алексей Шмуйлович от 06.11.2009, 19:05
Если отправить почту нужно полностью автоматически, то нужны какие-нибудь нестандартные библиотеки. У меня на работе что-то подобное прораммист делал из SQL Servera. При поступлении новых записей в базу срабатывает триггер и мне отправляется письмо. Надо спросить, как он это сделал.
А если достаточно сформировать письмо в Outlook, которое потом человек своей рукой отправит адресату, то это просто. Outlook через OLE вызываем и вперед. Тоже поискать нужно, у меня где-то было.
Какой вариант смотрим?

Не сочтите за наглость, но здается, что тема интересна не только мне, а посему — оба варианта. Хто его знает, как ползовательскопрограммная тропка повернется  ;) . Спасибо.

Путей к вершине — множество. Этот один из многих!

Ну ладно.
Вариант с отправкой через Outlook.

Public Sub sendmail()
    Dim olApp As Outlook.Application
    Dim objMail As Outlook.MailItem
    Set olApp = Outlook.Application
    ‘Create e-mail item
    Set objMail = olApp.CreateItem(olMailItem)

    With objMail
       ‘Set body format to HTML
       .To = «example@mail.ru»
       .BodyFormat = olFormatPlain
       .body = «Helo, World»
       .Send
    End With
End Sub

Можно использовать не .send, а .display, тогда подготовленное письмо будет ждать отправки вручную.

Второй вариант, независимый от Outlook скоро не обещаю — нужно будет пообщаться с программистом, а на работе сейчас дел невпроворот :(

Цитата: Алексей Шмуйлович от 06.11.2009, 22:55
Ну ладно.
Вариант с отправкой через Outlook.

Public Sub sendmail()
    Dim olApp As Outlook.Application
    Dim objMail As Outlook.MailItem
    Set olApp = Outlook.Application
    ‘Create e-mail item
    Set objMail = olApp.CreateItem(olMailItem)

    With objMail
       ‘Set body format to HTML
       .To = «example@mail.ru»
       .BodyFormat = olFormatPlain
       .body = «Helo, World»
       .Send
    End With
End Sub

Можно использовать не .send, а .display, тогда подготовленное письмо будет ждать отправки вручную.

Второй вариант, независимый от Outlook скоро не обещаю — нужно будет пообщаться с программистом, а на работе сейчас дел невпроворот :(

здорово, спасиба! Готов ждать …

Путей к вершине — множество. Этот один из многих!

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

Путей к вершине — множество. Этот один из многих!

Боюсь, что и он будет страдать те ми же недостатками. Внешнюю библиотеку, чтобы она работала, нужно регистрировать на рабочей станции, где она будет выполняться.

Цитата: Алексей Шмуйлович от 07.11.2009, 00:45
Боюсь, что и он будет страдать те ми же недостатками. Внешнюю библиотеку, чтобы она работала, нужно регистрировать на рабочей станции, где она будет выполняться.

— это наименьшее зло …

Путей к вершине — множество. Этот один из многих!

Алексей Шмуйлович
А подскажите — как записать дату открытия!!!???
Сорри!!! Протупил!!! Сам разобрался!!!

Вопрос немного в другом!!! А возможно ли  узнать ЧТО поменял пользователь!!!

Знания недостаточно, необходимо применение. Желания недостаточно, необходимо действие. (с) Брюс Ли

GWolf, Алексей Шмуйлович,

Проще всего для отправки писем через SMTP в скриптах и макросах использовать CDO — Collaboration Data Objects. Это стандартные библиотеки входящие в любую винду с 2000-й. Вот здесь http://www.paulsadowski.com/WSH/cdo.htm есть несколько подробно описанных примеров практически на все случаи жизни.

А Outlook , кстати, с настройками по умолчанию при использовании метода Send будет показывать пользователю сообщение (модальное!!), о том что какая-то программа пытается письмо отправить и разрешить её или нет и на какое время. (Это сделали типа для защиты от вирусописателей. В 2007-м отключается в настройках безопасности, а в 2003-м, единственный известный мне метод, отключается с геморроем и только при работе с Exchange)

Источник
Belkin
Обычный пользователь
Обычный пользователь
Аватара пользователя

 
Сообщения: 63
Зарегистрирован: 02.11.2007 (Пт) 18:02
Откуда: Рязань

Кто открыл сетевой xls файл для записи.

Видел аналогичный вопрос, но на него так и не ответили, поэтому хочу попытать еще раз счастье ;)

Подскажите как решить вопрос:
Есть сетевой xls файл, если кто-то его открывает первым на запись, то при открытии ручками этого файла появляется окно с сообщением, что данный файл открыт пользователем «XXX», открыть файл только для чтения?
1. Как можно программно до открытия этого файла узнать что он уже занят другим пользователем? (вопрос минимума)
2. Как узнать кто держит этот файл? (вопрос максимума)

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

Что смог накопать с сделать сам:
Только функцию для проверки занят ли файл. перед вызовом функции в параметр передавать проверенный (существующий) путь к файлу

Код: Выделить всё
Function file_read_only(strPath As String) As Boolean
On Error GoTo err

Dim fso As New FileSystemObject

'If fso.FileExists(strPath) = True Then 'файл существует
    Call fso.MoveFile(strPath, strPath) ' Пробуем переименовать в себя, если ошибка, то файл уже открыт кем-то с доступом на запись
    file_read_only = False 'Файл доступен для чтения
'End If
Exit Function

err:
    file_read_only = True ' Файл кем-то открыт

End Function

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

Андрей.

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Кто открыл сетевой xls файл для записи.

Сообщение iGrok » 10.02.2011 (Чт) 0:03

Универсального способа, насколько я знаю, нет.
В случае с документами офиса, рядом с документом создаётся «блокирующий» файлик, в котором указано имя открывшего юзера. Только это не имя машины, а имя, которое было указано при установке офиса. Поэтому оно толком ничем не поможет.

Точно это можно сделать на novell’овской сети, т.к. она предоставляет такой функционал (отслеживание блокировок, рассылка сообщений, принудительное отключение юзера при наличии соответствующих прав, и т.п.). Возможно, есть какие-то подобные механизмы в майкрософтовской сетке, но этого я не знаю.

label:

cli

jmp label

Belkin
Обычный пользователь
Обычный пользователь
Аватара пользователя

 
Сообщения: 63
Зарегистрирован: 02.11.2007 (Пт) 18:02
Откуда: Рязань

Re: Кто открыл сетевой xls файл для записи.

Сообщение Belkin » 10.02.2011 (Чт) 9:30

iGrok
Такой файлик создается для .doc файлов, для .xls я что-то не нахожу.
Если такое сообщение (о пользователе) выводит Excel, значит он где-то читает эту информацию, может через какие-то API функции.
Значит как-то можно вытащить имя пользователя, вопрос ТОЛЬКО КАК? :)
Наблюдения:
Если другой пользователь открыл .doc файл, то создается файлик с тем же именем, только в начале добавляется ~$
При этом если смотреть, то у оригинального файла не изменяется «Date Modifited», а у нового файлика эта дата становится в дату открытия.
С .xls файлами по другому: Нового файла не создается, а «Date Modifited» у самого файа изменяется в дату открытия.
Так может Excel пишит информацию о пользователе открывшем файл в сам .xls вайл? Если да, то как ее оттуда прочитать?

Андрей.

Gloom
Бывалый
Бывалый
Аватара пользователя

 
Сообщения: 200
Зарегистрирован: 23.11.2004 (Вт) 15:57
Откуда: СПб

Re: Кто открыл сетевой xls файл для записи.

Сообщение Gloom » 10.02.2011 (Чт) 14:28

Может имеет смысл разрешить общий доступ к книге?
Тогда можно будет воспользоваться свойством UserStatus
Вообще, имя пользователя excel хранит в самом файле и его даже можно оттуда вытащить.
Но, как уже было сказано, это не имя компьютера, а значение из свойства Application.UserName и пользователь может написать туда всё, что ему заблагорассудится. Т.е. для цели отправки сообщения информация бесполезная.

Belkin
Обычный пользователь
Обычный пользователь
Аватара пользователя

 
Сообщения: 63
Зарегистрирован: 02.11.2007 (Пт) 18:02
Откуда: Рязань

Re: Кто открыл сетевой xls файл для записи.

Сообщение Belkin » 10.02.2011 (Чт) 15:47

Gloom
Нет, про общий доступ речи не идет.
А на счет имени, это действительно имя которое задано при установки офиса.
НО! В нашей большой организации это делается так, что это имя соответствует логину пользователя.
Поэтому, всеже я хотел бы извлечь это имя, а потом решать что с ним делать.
ПОДСКАЖИТЕ как вытащить это имя?

Андрей.

Gloom
Бывалый
Бывалый
Аватара пользователя

 
Сообщения: 200
Зарегистрирован: 23.11.2004 (Вт) 15:57
Откуда: СПб

Re: Кто открыл сетевой xls файл для записи.

Сообщение Gloom » 10.02.2011 (Чт) 17:10

Ну, в структуре xls файла (BIFF — Binary Interchange File Format) есть раздел WriteAccess:
The WriteAccess record specifies the name of the user who last created, opened, or modified the
file.
Т.е. нужно открыть файл, найти этот самый раздел и прочитать его.
Вот здесь (функция LastUser), например, это делается, но достаточно примитивно — будет работать, если в имени пользователя используется только английские буквы.
Также этот метод не сработает на файлах с парольной защитой, т.к. в этом случае раздел WriteAccess шифруется.

Belkin
Обычный пользователь
Обычный пользователь
Аватара пользователя

 
Сообщения: 63
Зарегистрирован: 02.11.2007 (Пт) 18:02
Откуда: Рязань

Re: Кто открыл сетевой xls файл для записи.

Сообщение Belkin » 10.02.2011 (Чт) 20:54

Gloom
ОГРОМНОЕ спасибо!
Судя по всему, это то что и хотел.

Хорошо бы было если такую информацию можно было бы получать для любого файла (например .txt)

Еще раз СПАСИБО!

Андрей.

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Кто открыл сетевой xls файл для записи.

Сообщение iGrok » 10.02.2011 (Чт) 22:21

Belkin писал(а):Хорошо бы было если такую информацию можно было бы получать для любого файла (например .txt)

Ну, я в первом же посту ответил насчёт этого.

Только если такой функционал поддерживает сам файл-сервер.
Если шара поднята на новелле или на самбе — они это умеют. Правда, не «стандартными» функциями, но в целом реализацию сделать можно.
Про виндовые файл-серверы — не знаю. Скорей всего, нет.

UPD:
А может и есть.
Копать в этом направлении:

http://www.kuban.ru/forum_new/forum15/arhiv/8411.html

UPD2:
Да и вот тут вроде что-то давали:

viewtopic.php?f=2&t=15322

label:

cli

jmp label

Belkin
Обычный пользователь
Обычный пользователь
Аватара пользователя

 
Сообщения: 63
Зарегистрирован: 02.11.2007 (Пт) 18:02
Откуда: Рязань

Re: Кто открыл сетевой xls файл для записи.

Сообщение Belkin » 11.02.2011 (Пт) 9:31

iGrok
Спасибо, я тебя еще в первом посте услышал.
Впринципе, я получил, что хотел. А остальное — размышление в слух.

Андрей.

Egor Olegovich
Начинающий
Начинающий
 
Сообщения: 1
Зарегистрирован: 06.03.2013 (Ср) 12:22

Re: Кто открыл сетевой xls файл для записи.

Сообщение Egor Olegovich » 06.03.2013 (Ср) 12:28

В программе Excel в меню Сервис выбираем доступ к книге.Откроется окно и смотрим кто же у нас открыл этот файл.Подсказал мой коллега мне!!!Пользуйтесь на здоровье. :D

Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot и гости: 2

Источник
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245

Option Compare Database
Option Explicit
 
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public CompName As String 'объявляем переменную доступную для всего проекта
 
Dim Workbooks As Object
Dim xlWbkEx As Object
Dim xlAppEx As Object
 
Public Rowss1 As Variant
Public Rowss2 As Integer
 
'Const MyFile = "P:Судебные делаСУДЕБНЫЕ ДЕЛА 2015 ОПОСД.xls"
Const MyFile = "c:iSKi_XДЕЛА 2015 ОПОСД.xls"
Const l = "Сводная таблица_2015г"
 
Public rng As Object
 
Sub reportToExcel_Isk()
 
Call StatusBarYes
 
Set xlAppEx = CreateObject("Excel.Application.14") 'создаем объект Excel, чтобы можно было работать с его методами и свойствами
 
Again:
'проверка на открытие файла
If IsOpen(MyFile) Then
    MsgBox "Файл " & MyFile & " УЖЕ кем-то ИСПОЛЬЗУЕТСЯ. Останавливаемся.", vbExclamation
    DoCmd.HourGlass False
    Call Get_UserStatus_Info
    Exit Sub
 
Else
    DoCmd.HourGlass False
    MsgBox "Файл " & MyFile & " никем не используется. Продолжаем...", vbInformation
End If
 
'запрос значения Rowss - указать номер строки под которой надо вставить
Rowss1 = InputBox("Введите номер строки, ПОД которой надо вставить новую строку", "Ввод числа")
 
Dim myReply
 
If Not IsNumeric(Rowss1) Then
        myReply = MsgBox("Номер строки был указан не цифрой. Повторить процедуру?", vbYesNo + vbQuestion + vbApplicationModal, "Ввод номера строки")
        If myReply = vbNo Then
        Exit Sub
        End If
        If myReply = vbYes Then
        MsgBox "Повторяем..."
        GoTo Again
        End If
       
Else: GoTo 1
 
If Rowss1 = "" Then
        myReply = MsgBox("Номер строки не указан. Остановить процедуру?", vbYesNo + vbQuestion + vbApplicationModal, "Ввод номера строки")
        If myReply = vbYes Then
        Exit Sub
        End If
        If myReply = vbNo Then
        MsgBox "Повторяем..."
        GoTo Again
        End If
       
Else: GoTo 1
End If
    
1:
    Dim Msg, Style, Title, Response
    Msg = "Вы правильно указали номер строки ПОД которой вставить? " & " ---> " & Rowss1 & vbCr & "Будет вставлена строка:  ---> " & Rowss1 + 1 & vbCr & "Продолжаем?" 'ns
    Style = vbYesNo + vbQuestion + vbApplicationModal
    Title = "Ввод номера строки"
    
    Response = MsgBox(Msg, Style, Title)
        If Response = vbNo Then    ' User chose No.
            MsgBox "Исправьте значение и продолжайте", vbApplicationModal, "Ввод номера строки"
            GoTo Again
        Else    ' User chose Yes.
            MsgBox "Продолжаем!", vbApplicationModal
        End If
  
End If
 
DoCmd.HourGlass (-1) 'True
    
'Rowss1 = ns
Rowss2 = Rowss1 + 1
 
'strPathExcel = MyFile
Set xlWbkEx = xlAppEx.Workbooks.Open(MyFile)
 
'то добавляем строку
xlWbkEx.Worksheets(l).Rows(Rowss2).Insert
 
'Запомним нашу строку
'Set newrow = xlWbk.Worksheets(L).Rows(Rowss2)
 
With xlWbkEx.Worksheets(l)
    .Rows(Rowss1).Copy
    .Rows(Rowss2).PasteSpecial Paste:=-4122
    .Rows(Rowss2).Select
    
    'динамически формируем адрес нужной ячейки и задаем ей значение
    .Range("A" & Rowss2).Value = "МКП ""Воронежтеплосеть"" "
    .Range("B" & Rowss2).Value = Forms![Данные]![Краткое_наименование] '.Value 'если поле
    .Range("D" & Rowss2).Value = "№ " & Forms![Данные]![Номер_платежки] & " от " & Forms![Данные]![Дата_платежки] '.Value 'если поле
    .Range("E" & Rowss2).Value = Date   '.Value 'если поле
    .Range("F" & Rowss2).Value = "взыскание задолженности за тепловую энергию"
    .Range("G" & Rowss2).Value = Forms![Данные]![Начало_периода] & "-" & Forms![Данные]![Конец_периода]
    .Range("J" & Rowss2).Value = Nz(Forms![Данные]![Сумма_долга], 0) + Nz(Forms![Данные]![Сумма_процентов], 0)
    .Range("X" & Rowss2).Value = "С.А.Калинин"
    
     '  .Range("B10").Value = "B10-наше значение"
     '  .[D5] = Forms![Данные]![Краткое_наименование]
    
    ' задаем диапазон выбора ячеек и задаем им форматирование границ
    'Set rng = .Range("A" & Rowss2, "X" & Rowss2)
    'Call make_border_2
 
End With
 
xlAppEx.CutCopyMode = False
xlAppEx.Visible = True 'запускаем приложение Excel, можно сдвинуть вниз
 
'Set appEx = Nothing 'уничтожаем переменную с объектом
Set xlAppEx = Nothing
Set xlWbkEx = Nothing
'Set ns = Nothing
Set Rowss1 = Nothing
 
Call StatusBarNo
 
End Sub
 
Public Function IsOpen(File$) As Boolean
Dim fn%
fn = FreeFile
On Error Resume Next
Open File For Random Access Read Write Lock Read Write As #fn
Close #fn
IsOpen = Err
End Function
Public Sub Get_UserStatus_Info()
Dim asUsers, sUserName As String, sDateTime As String, sStatus As String
Dim li As Long
 
Dim xlAppExGet As Object
Set xlAppExGet = GetObject(MyFile)
 
 
    On Error Resume Next
 
asUsers = xlAppExGet.Workbooks(MyFile).UserStatus
    
    Select Case Err.number
    Case 9:
        MsgBox "Файл отсутствует? " & vbNewLine & "Номер ошибки: " & Err.number & vbNewLine & "Описание ошибки: " & Err.Description
        'Resume Next
        Err.Clear
        Exit Sub
    End Select
    
 
For li = 1 To UBound(asUsers, 1)
sUserName = sUserName & vbNewLine & asUsers(li, 1) & "; время изменения файла: " & Format(asUsers(li, 2), "dd.mm.yyyy hh:mm")
sDateTime = asUsers(li, 2)
    Select Case asUsers(li, 3)
        Case 1
        sStatus = "Монопольный"
        Case 2
        sStatus = "Общий"
        Case Else
        sStatus = "Не определен"
    End Select
Next
 
MsgBox "Пользователи файла:" & vbNewLine & sUserName & vbNewLine & "Доступ к файлу - " & sStatus
 
Call Get_LogonUser
Call Get_ComputerName
 
Debug.Print IIf(xlAppExGet.Workbooks("c:iSKi_XДЕЛА 2015 ОПОСД.xls").UserStatus(1, 3) = 1, "Exclusive", "Shared")
 
Set xlAppExGet = Nothing
 
End Sub
 
Public Sub Get_LogonUser()
MsgBox "LogonDomain: " & GetLogonDomainuser & " / " & "LogonUser: " & GetLogonUser
End Sub
 
Public Function GetLogonDomainuser() As String
Dim lResult As Long
Dim i As Integer
Dim bUserSid(255) As Byte
Dim sUserName As String
Dim sDomainName As String * 255
Dim lDomainNameLength As Long
Dim lSIDType As Long
sUserName = GetLogonUser
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
sDomainName = Space(lDomainNameLength)
lResult = LookupAccountName(vbNullString, sUserName, bUserSid(0), 255, sDomainName, lDomainNameLength, lSIDType)
If (lResult = 0) Then
MsgBox "Ошибка: невозможно найти имя домена для юзера: " & sUserName
Exit Function
End If
sDomainName = Left$(sDomainName, InStr(sDomainName, Chr$(0)) - 1)
GetLogonDomainuser = Trim(sDomainName)
End Function
Public Function GetLogonUser() As String
Dim strTemp As String, strUserName As String
strTemp = String(100, Chr$(0))
strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)
strUserName = String(100, Chr$(0))
GetUserName strUserName, 100
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetLogonUser = strUserName
End Function
 
Public Function UserName() As String
Dim cn As String
Dim ls As Long
Dim Res As Long
cn = String(1024, 0)
ls = 1024
Res = GetUserName(cn, ls)
If Res <> 0 Then
UserName = Mid(cn, 1, InStr(cn, Chr(0)) - 1)
Else
UserName = ""
End If
End Function
 
Public Sub Get_ComputerName()
Dim scomp As String, h As String
 
scomp = Space(255)
h = GetComputerName(scomp, 255)
CompName = Trim(scomp)
MsgBox "Имя компьютера, с которого открыт файл:  " & CompName
End Sub
Источник

Понравилась статья? Поделить с друзьями:
  • Vba excel корень числа
  • Vba excel копия файла
  • Vba excel копируем диапазон
  • Vba excel копировать ячейку
  • Vba excel копировать форматирование