Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Свойства файла (макрос)
 
#1
29.08.2011 15:04:06
Пытаюсь написать макрос для извлечения свойств файла. Получилось так:  
 
Sub load_file()  
Set FSO = CreateObject("Scripting.FileSystemObject")  
Set File = FSO.GetFile(Application.GetOpenFilename)  
Cells(4, 4) = File.Name  
Cells(4, 5) = File.DateCreated  
Cells(4, 6) = File. --- тут не могу сделать автора файла  
Cells(4, 7) = File.DateLastModified  
Cells(4, 8) = File. --- тут не могу сделать кто последний раз менял файл  
Cells(4, 9) = File  
End Sub
 
 
 
#2
29.08.2011 15:20:13
Нет таких свойств у File Object.  
Если это документ Office, то его надо открыть и брать свойства документа.
 
 
 
#3
29.08.2011 15:24:51
а без открытия файла нельзя?
 
 
 
#4
29.08.2011 15:26:08
Посмотрите в сторону .BuiltinDocumentProperties  
MsgBox ThisWorkbook.BuiltinDocumentProperties("Last Author")
 
 
 
#5
29.08.2011 15:46:11
Да, без открытия документа до нужных вам свойств не докопаться...  
После открытия файла выполните:  
Sub PrintDocPropNames()  
  Dim prop As DocumentProperty  
  For Each prop In ActiveWorkbook.BuiltinDocumentProperties  
Debug.Print prop.Name  
  Next  
End Sub  
и узнаете имена всех имеющихся в нём встроенных свойств  
А потом, выяснив что вам нужно считывать, обращайтесь к свойству по его имени как к элементу коллекции,  
например,  
Debug.Print ActiveWorkbook.BuiltinDocumentProperties("Last author") - имя последнего редактировавшего.
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
 
 
#6
29.08.2011 19:45:24
{quote}{login=enzo}{date=29.08.2011 03:24}{thema=}{post}а без открытия файла нельзя?{/post}{/quote}  
Без загрузки в Excel можно получить информацию о свойствах файла.  
Файл, в принципе, можеть быть любым, не обязтельно от Excel:  
 
Function GetFileInfo(PathName As String, FileName As String, Optional i& = 9)  
 ' ZVI:2011-08-29 http://www.planetaexcel.ru/forum.php?thread_id=31105  
 ' Получение свойств файла  
 '-------------------  
 ' PathName - папка  
 ' FileName -  
 ' i - номер свойства  
 '-------------------  
 'i=0 - Имя, 1 - Размер, 2 - Тип, 3 - Изменен, 4 - Дата создания, 5 - Открыт  
 'i=6 - Атрибуты, 7 - Состояние, 8 - Владелец,  9 - Автор,10 - Заголовок  
 'i=11 - Тема, 12 - Категория, 13 - Страницы, 14 - Комментарий  
 Dim a$(0 To 15), j&  
 If Dir(PathName & IIf(Right(PathName, 1) <> "\", "\", "") & FileName) = "" Then Exit Function  
 With CreateObject("Shell.Application").Namespace((PathName))  
   For j = 0 To 14  
     a(j) = .GetDetailsOf(.ParseName((FileName)), j)  
   Next  
 End With  
 GetFileInfo = a  
End Function  
 
Sub ShowFileInfo()  
 Dim x  
 x = GetFileInfo("C:\Temp", "Test.xls")  
 If IsArray(x) Then  
   Debug.Print "Имя:", x(0)  
   Debug.Print "Размер:", x(1)  
   Debug.Print "Тип:", x(2)  
   Debug.Print "Изменен:", x(3)  
   Debug.Print "Создан:", x(4)  
   Debug.Print "Открыт:", x(5)  
   Debug.Print "Аттрибут:", x(6)  
   Debug.Print "Состояние:", x(7)  
   Debug.Print "Владелец:", x(8)  
   Debug.Print "Автор:", x(9)  
   Debug.Print "Заголовок:", x(10)  
   Debug.Print "Тема:", x(11)  
   Debug.Print "Категории:", x(12)  
   Debug.Print "Страницы:", x(13)  
   Debug.Print "Комментарий:", x(14)  
 Else  
   Debug.Print "Файл не найден"  
 End If  
End Sub
 
 
 
#7
29.08.2011 19:47:16
Потерялось:  
' FileName - имя файла
 
 
 
#8
29.08.2011 21:54:02
Немного подправил код (подключил параметр i):  
 
Function GetFileInfo(PathName As String, FileName As String, Optional i)  
 ' ZVI:2011-08-29 http://www.planetaexcel.ru/forum.php?thread_id=31105  
 ' Получение свойств файла  
 '-------------------  
 ' PathName - папка  
 ' FileName - имя файла  
 ' i - номер свойства (см ниже),  
 ' если параметр i не указан, то возвращается массив свойств  
 '-------------------  
 'i = 0-Имя,1-Размер,2-Тип,3-Изменен,4-Дата создания,5-Открыт  
 'i = 6-Атрибуты,7-Состояние,8-Владелец,9-Автор,10-Заголовок  
 'i = 11-Тема,12-Категория,13-Страницы,14-Комментарий  
 '-------------------  
 Dim a, j&  
 If Dir(PathName & IIf(Right(PathName, 1) <> "\", "\", "") & FileName) = "" Then Exit Function  
 With CreateObject("Shell.Application").Namespace((PathName))  
   If IsMissing(i) Then  
     ReDim a(0 To 14)  
     For j = 0 To UBound(a)  
       a(j) = .GetDetailsOf(.ParseName((FileName)), j)  
     Next  
   Else  
     a = .GetDetailsOf(.ParseName((FileName)), i)  
   End If  
 End With  
 GetFileInfo = a  
End Function  
 
Sub ShowFileInfo()  
 Dim x  
 x = GetFileInfo("C:\Temp", "Test.xls")  
 If IsArray(x) Then  
   Debug.Print "Имя:", x(0)  
   Debug.Print "Размер:", x(1)  
   Debug.Print "Тип:", x(2)  
   Debug.Print "Изменен:", x(3)  
   Debug.Print "Создан:", x(4)  
   Debug.Print "Открыт:", x(5)  
   Debug.Print "Аттрибут:", x(6)  
   Debug.Print "Состояние:", x(7)  
   Debug.Print "Владелец:", x(8)  
   Debug.Print "Автор:", x(9)  
   Debug.Print "Заголовок:", x(10)  
   Debug.Print "Тема:", x(11)  
   Debug.Print "Категории:", x(12)  
   Debug.Print "Страницы:", x(13)  
   Debug.Print "Комментарий:", x(14)  
 Else  
   Debug.Print "Файл не найден"  
 End If  
End Sub  
 
Sub Test_ShowAuthor()  
 Debug.Print "Автор:", GetFileInfo("C:\Temp", "Test.xls", 9)  
End Sub
 
 
 
#9
30.08.2011 08:10:00
Спасибо. а можно сделать x = GetFileInfo("C:\Temp", "Test.xls") через выбор (Application.GetOpenFilename)?
 
 
 
#10
30.08.2011 08:12:26
{quote}{login=enzo}{date=30.08.2011 08:10}{thema=}{post}Спасибо. а можно сделать x = GetFileInfo("C:\Temp", "Test.xls") через выбор (Application.GetOpenFilename)?{/post}{/quote}  
или придется делать через мою, потом выдирать оттуда PATH и Name вместо ("C:\Temp", "Test.xls")?
 
 
 
#11
30.08.2011 09:30:41
ZVI, спасибо! Пригодится : )
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#12
31.08.2011 13:37:46
Получилось так:  
 
Function GetFileInfo(PathName, FileName, Optional i)  
Dim a, j&  
If Dir(PathName & IIf(Right(PathName, 1) <> "\", "\", "") & FileName) = "" Then Exit Function  
With CreateObject("Shell.Application").Namespace((PathName))  
If IsMissing(i) Then  
ReDim a(0 To 14)  
For j = 0 To UBound(a)  
a(j) = .GetDetailsOf(.ParseName((FileName)), j)  
Next  
Else  
a = .GetDetailsOf(.ParseName((FileName)), i)  
End If  
End With  
GetFileInfo = a  
End Function  
 
'Загрузка файла  
Sub load_file()  
Set FSO = CreateObject("Scripting.FileSystemObject")  
Set File = FSO.GetFile(Application.GetOpenFilename)  
Cells(4, 4) = File.Name  
Cells(4, 5) = File.DateCreated  
'Cells(4, 6) Creator from Function  
Cells(4, 7) = File.DateLastModified  
'Cells(4, 8) Changer from Function  
Cells(4, 9) = File.ParentFolder  
'Применение функции  
Dim x1, x2  
s = Cells(4, 4)  
d = Cells(4, 9)  
x1 = GetFileInfo(d, s, 8)  
x2 = GetFileInfo(d, s, 9)  
If IsArray(x1) Then  
Debug.Print "Владелец:", x1(8)  
Else  
Debug.Print "Файл не найден"  
End If  
If IsArray(x2) Then  
Debug.Print "Автор:", x2(9)  
Else  
Debug.Print "Файл не найден"  
End If  
Cells(4, 8) = x1  
Cells(4, 6) = x2  
End Sub  
 
Всем спасибо, все работает :)
 
 
 
Страницы: 1
Читают тему
Наверх