Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Протоколирование открытия документа!
 
#1
11.09.2009 09:06:54
Добрый день, подскажите в чем может быть проблема, в документ на событие открытия файла добавлен код, протоколирующий, кто документ открыл:  
r = Worksheets("Автор").Range("A2:A10000")  
d = WorksheetFunction.CountA®  
Worksheets("Автор").Range("A2").Offset(d, 0).Value = Now  
Worksheets("Автор").Range("A2").Offset(d, 1).Value = Application.UserName  
Worksheets("Автор").Range("A2").Offset(d, 2).Value = CreateObject("WScript.Network").ComputerName  
Worksheets("Автор").Range("A2").Offset(d, 3).Value = "Открытие файла"  
Worksheets("Автор").Columns("A:D").AutoFit  
Но на некоторых компьютерах пользователей в других городах строка  
Worksheets("Автор").Range("A2").Offset(d, 2).Value = CreateObject("WScript.Network").ComputerName  
Выдает ошибку Run-time error '91'  
В чем может быть заковыка?  
Может какую проверку можно добавить?
 
 
 
#2
11.09.2009 10:14:36
В интернете нашел вот такой код: но он у меня ругается на строку  
   Dim oNetwork As WshNetwork  
 
Private Sub Workbook_Open()  
   Dim oNetwork As WshNetwork  
   Dim sComputer As String  
   Dim sUser As String  
   Set oNetwork = CreateObject("WScript.Network")  
   sComputer = oNetwork.ComputerName  
   sUser = oNetwork.UserName  
       r = Worksheets("Автор").Range("A2:A10000")  
       d = WorksheetFunction.CountA®  
       Worksheets("Автор").Range("A2").Offset(d, 0).Value = Now  
       Worksheets("Автор").Range("A2").Offset(d, 1).Value = sUser  
       Worksheets("Автор").Range("A2").Offset(d, 2).Value = sComputer  
       Worksheets("Автор").Range("A2").Offset(d, 3).Value = "Открытие файла"  
       Worksheets("Автор").Columns("A:D").AutoFit  
   Set oNetwork = Nothing
 
 
 
#3
11.09.2009 10:23:55
{quote}{login=Punker}{date=11.09.2009 10:14}{thema=}{post}В интернете нашел вот такой код: но он у меня ругается на строку  
   Dim oNetwork As WshNetwork  
{/post}{/quote}  
 
Ну так уберите эту строку, раз на неё ругается. И всё будет работать.  
 
Чтобы при наличии этой строки VBA не ругался, надо в Tools - References подключать соответствующую библиотеку  
В данном случае это ни к чему.  
 
И код можно немного сократить:  
 
Private Sub Workbook_Open()  
   Dim ra As Range: Set ra = Worksheets("Автор").Range("A" & Rows.Count).End(xlUp).Offset(1)  
   With CreateObject("WScript.Network")  
       ra.Resize(, 4) = Array(Now, .UserName, .ComputerName, "Открытие файла")  
   End With  
   ra.EntireColumn.AutoFit  
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#4
11.09.2009 10:28:47
Небольшая ошибка...  
Последнюю строчку макроса надо писать так:  
 
ra.Resize(, 4).EntireColumn.AutoFit  
 
 
 
PS: На будущее - d = WorksheetFunction.CountA® - не самый лучший способ искать первую незаполненную строку на листе.  
Использование Range("A" & Rows.Count).End(xlUp) предпочтительнее
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
11.09.2009 11:15:02
Да я чайник в VBA, код уже не помню где взял, может здесь, а может в инете.  
Спасибо огромное, EducatedFool, сейчас отправлю в город, где файл при открытии выдавал ошибку.
 
 
 
#6
11.09.2009 12:31:55
Да, все по-прежнему, выдает ошибку 91 на строке:  
ra.Resize(, 4) = Array(Now, .UserName, .ComputerName, "Открытие файла")  
 
Я так понимаю какая-то проблема с .ComputerName на том компьютере?
 
 
 
#7
11.09.2009 14:31:26
Может перед строчкой  
ra.Resize(, 4) = Array(Now, .UserName, .ComputerName, "Открытие файла")  
поставить On Error Resume Next?  
 
Если я правильно понимаю смысл этого кода?
 
 
 
#8
11.09.2009 14:51:56
На моем компьютере этот код работает, но поиском я не нашел файла wshom.exe
 
 
 
#9
11.09.2009 15:11:18
Есть wshom.ocx
Bite my shiny metal ass!      
 
 
 
#10
11.09.2009 15:16:17
Да Лузер, спасибо, такой файл нашел у себя, написал в Новокузнецк, будут смотреть у себя такой файл.
 
 
 
#11
11.09.2009 15:25:10
Кстати у меня в References галочка на Windows Script Host Object Model не стоит.  
А у меня код работает.
 
 
 
#12
11.09.2009 21:57:30
Может голову не греть, а использовать WinAPI вместо WSH?  
Private Declare Function GetComputerName _    
       Lib "kernel32.dll" Alias "GetComputerNameA" ( _    
       ByVal lpBuffer As String, _    
       nSize As Long) As Long    
 
Private Sub WinAPI_ComputerName()    
   Dim iComputerName As String * 255    
 
   GetComputerName iComputerName, 255&    
 
   MsgBox "Имя компьютера : " & _    
   Application.Clean(iComputerName)    
End Sub  
 
Private Declare Function GetUserName _    
       Lib "advapi32.dll" Alias "GetUserNameA" ( _    
       ByVal lpBuffer As String, _    
       nSize As Long) As Long    
 
Private Sub WinAPI_UserName()    
   Dim iUserName As String * 255    
 
   GetUserName iUserName, 255&    
 
   MsgBox "Имя пользователя : " & _    
   Application.Clean(iUserName)    
End Sub
Bite my shiny metal ass!      
 
 
 
#13
14.09.2009 09:20:49
Спасибо, у себя записал - работает, буду проверять на остальных.  
В итоге соединил код от EducatedFool и от Лузер (спасибо вам огромное), результат вот:  
 
Private Sub Workbook_Open()  
   Dim iUserName As String * 255  
       GetUserName iUserName, 255&  
   Dim iComputerName As String * 255  
       GetComputerName iComputerName, 255&  
   Dim ra As Range: Set ra = Worksheets("Автор").Range("A" & Rows.Count).End(xlUp).Offset(1)  
       With Application  
           ra.Resize(, 4) = Array(Now, .Clean(iUserName), .Clean(iComputerName), "Открытие файла")  
       End With  
   ra.Resize(, 4).EntireColumn.AutoFit  
End Sub  
 
Ну и в модуль запихнул это:  
 
Public Declare Function GetUserName _  
Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long  
Public Declare Function GetComputerName _  
Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long  
 
Вроде все правильно сделал?
 
 
 
#14
14.09.2009 09:29:02
Йес!!! Работает и в Новокузнецке  
Спасибо всем огромнейшее (правда осталось проверить еще в 20-и городах :)
 
 
 
Страницы: 1
Читают тему
Наверх