Добрый день! Только начал изучать VBA, возникли сложности. Подкорректируйте пожалуйста код - Эксель все делает правильно (берет из свойств фотографии дату создания фото), но дату (столбец B:B) ставит в виде текста. Никакое форматирование не помогает... Нужно сделать так, чтобы дата записывалась в формате ГГГ.ММ.ДД_чч.мм.
[vba]
Код
'1. Перечисление файлов
'Задание переменных Dim i As Integer Dim oFSO As Object Dim oFolder As Object Dim objFile As Object Dim adres As String
Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder(adres)
'Перечисление файлов и запись их в эксель 'Создание цикла For Each objFile In oFolder.Files Cells(i + 2, 1) = objFile.name Cells(i + 2, 3) = adres i = i + 1 Next objFile
'2. Записать только определенный параметр
Dim ns As Object Dim cicl As Integer Dim n As Integer Dim adres1 Dim name Dim kol kol = Cells(Rows.Count, 1).End(xlUp).Row
For cicl = 2 To kol adres1 = Cells(cicl, 3) name = Cells(cicl, 1) Set ns = CreateObject("Shell.Application").Namespace(adres1) Cells(cicl, 2) = ns.GetDetailsOf(ns.ParseName(name), 12) Set ns = Nothing Range("b:b").NumberFormat = "yyyy.mm.dd hh:mm" Next
'Автоформатирование ширины столбцов Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select
[/vba]
Добрый день! Только начал изучать VBA, возникли сложности. Подкорректируйте пожалуйста код - Эксель все делает правильно (берет из свойств фотографии дату создания фото), но дату (столбец B:B) ставит в виде текста. Никакое форматирование не помогает... Нужно сделать так, чтобы дата записывалась в формате ГГГ.ММ.ДД_чч.мм.
[vba]
Код
'1. Перечисление файлов
'Задание переменных Dim i As Integer Dim oFSO As Object Dim oFolder As Object Dim objFile As Object Dim adres As String
Set oFSO = CreateObject("Scripting.FileSystemObject") Set oFolder = oFSO.GetFolder(adres)
'Перечисление файлов и запись их в эксель 'Создание цикла For Each objFile In oFolder.Files Cells(i + 2, 1) = objFile.name Cells(i + 2, 3) = adres i = i + 1 Next objFile
'2. Записать только определенный параметр
Dim ns As Object Dim cicl As Integer Dim n As Integer Dim adres1 Dim name Dim kol kol = Cells(Rows.Count, 1).End(xlUp).Row
For cicl = 2 To kol adres1 = Cells(cicl, 3) name = Cells(cicl, 1) Set ns = CreateObject("Shell.Application").Namespace(adres1) Cells(cicl, 2) = ns.GetDetailsOf(ns.ParseName(name), 12) Set ns = Nothing Range("b:b").NumberFormat = "yyyy.mm.dd hh:mm" Next
'Автоформатирование ширины столбцов Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select
Мне нужна именно дата съемки - она находится во вкладке "Подробно" Я пробовал, не получилось. Дата отображается с дополнительными символами. Если их удалить, то дата отобразится нормально. Попробуйте скопировать код и сделать ссылку на папку с фотографиями (только скопируйте их в отдельную папку, а то мало ли:)) В строке ввода даты поставить курсор и перемещать стрелками вправо или влево. Символы не отображаются, но они есть. В какой то момент нажмете на стрелку, но курсор не переместиться. Я копирую это и делаю замену. Тогда все получается.
Мне нужна именно дата съемки - она находится во вкладке "Подробно" Я пробовал, не получилось. Дата отображается с дополнительными символами. Если их удалить, то дата отобразится нормально. Попробуйте скопировать код и сделать ссылку на папку с фотографиями (только скопируйте их в отдельную папку, а то мало ли:)) В строке ввода даты поставить курсор и перемещать стрелками вправо или влево. Символы не отображаются, но они есть. В какой то момент нажмете на стрелку, но курсор не переместиться. Я копирую это и делаю замену. Тогда все получается.Voloz
If ns.GetDetailsOf(ns.ParseName(name), 12) <> "" Then Cells(cicl, 2) = CDate(Replace(Replace(ns.GetDetailsOf(ns.ParseName(name), 12), ChrW(8206), ""), ChrW(8207), ""))
[/vba] или с регулярками [vba]
Код
'2. Записать только определенный параметр
Dim ns As Object Dim cicl As Integer Dim n As Integer Dim adres1 Dim name Dim kol Dim ObjRegex As Object Set ObjRegex = CreateObject("vbscript.regexp") With ObjRegex .Global = True .Pattern = "[^0-9.: /g]" End With
kol = Cells(Rows.Count, 1).End(xlUp).Row
For cicl = 2 To kol adres1 = Cells(cicl, 3) name = Cells(cicl, 1) Set ns = CreateObject("Shell.Application").Namespace(adres1) If ns.GetDetailsOf(ns.ParseName(name), 12) <> "" Then Cells(cicl, 2) = CDate(ObjRegex.Replace(ns.GetDetailsOf(ns.ParseName(name), 12), "")) Set ns = Nothing Range("b:b").NumberFormat = "yyyy.mm.dd hh:mm" Next
[/vba]
Попробуйте эту строчку так записать [vba]
Код
If ns.GetDetailsOf(ns.ParseName(name), 12) <> "" Then Cells(cicl, 2) = CDate(Replace(Replace(ns.GetDetailsOf(ns.ParseName(name), 12), ChrW(8206), ""), ChrW(8207), ""))
[/vba] или с регулярками [vba]
Код
'2. Записать только определенный параметр
Dim ns As Object Dim cicl As Integer Dim n As Integer Dim adres1 Dim name Dim kol Dim ObjRegex As Object Set ObjRegex = CreateObject("vbscript.regexp") With ObjRegex .Global = True .Pattern = "[^0-9.: /g]" End With
kol = Cells(Rows.Count, 1).End(xlUp).Row
For cicl = 2 To kol adres1 = Cells(cicl, 3) name = Cells(cicl, 1) Set ns = CreateObject("Shell.Application").Namespace(adres1) If ns.GetDetailsOf(ns.ParseName(name), 12) <> "" Then Cells(cicl, 2) = CDate(ObjRegex.Replace(ns.GetDetailsOf(ns.ParseName(name), 12), "")) Set ns = Nothing Range("b:b").NumberFormat = "yyyy.mm.dd hh:mm" Next