VBA Excel. Функция FileDateTime

Определение даты и времени создания или последнего изменения любого файла в VBA Excel. Функция FileDateTime — описание, синтаксис, примеры.

Содержание

Функция FileDateTime в VBA Excel

Описание

Определение функции FileDateTime:

FileDateTime — это функция, которая возвращает дату и время создания или последнего изменения любого файла по его полному имени. Тип возвращаемых данных — Variant (Date).

Формат отображения даты и времени зависит от региональных настроек системы. Российский формат — dd.mm.yyyy h:nn:ss.

Из наблюдений можно отметить, что функция FileDateTime, как правило, возвращает дату и время, которые отображаются в папке проводника справа от выбранного файла в столбце «Дата изменения» или «Дата», как на скриншоте из третьего примера.

Синтаксис

1	FileDateTime(pathname)

pathname — полное имя файла, включающее букву диска, вложенные папки и краткое имя файла с расширением.

Примеры с функцией FileDateTime

Пример 1

Есть файл «Отчет.xlsx» по адресу «C:\Users\Evgeniy\Desktop», который был изменен ‎13 ‎августа ‎2022 ‎г., ‏‎0:55:05 (окно «Свойства:Отчет.xlsx»). Проверяем, что будет отображено в информационном окне MsgBox при использовании переменных разного типа для присвоения значений, возвращенных функцией FileDateTime:

Sub Primer1()

Dim d As Date, s As String, n As Double

d = FileDateTime("C:\Users\Evgeniy\Desktop\Отчет.xlsx")

MsgBox d 'Результат: 13.08.2022 0:55:05

s = FileDateTime("C:\Users\Evgeniy\Desktop\Отчет.xlsx")

MsgBox s 'Результат: 13.08.2022 0:55:05

n = FileDateTime("C:\Users\Evgeniy\Desktop\Отчет.xlsx")

MsgBox n 'Результат: 44786,0382523148

End Sub

Пример 2

Примеры отображения в VBA Excel только даты, возвращенной функцией FileDateTime:

Sub Primer2()

Dim d As Date

d = FileDateTime("C:\Users\Evgeniy\Desktop\Отчет.xlsx")

MsgBox Format(d, "Short Date") 'Результат: 13.08.2022

MsgBox Format(d, "dd.mm.yy") 'Результат: 13.08.22

End Sub

Пример 3

Есть папка с файлами:

Необходимо из кода VBA Excel получить список файлов в папке «C:\Users\Evgeniy\Desktop\Новая папка», пройтись по списку файлов циклом For Each… Next и записать на активный рабочий лист следующую информацию:

№ п/п — в первый столбец со второй строки;
имя файла — во второй столбец;
дату и время изменения файла — в третий столбец;
создать строку заголовков — «№ п/п», «Имя» и «Дата»;
осуществить автоподбор ширины столбцов и добавить границы ячеек.

Для получения списка файлов в заданной папке будем использовать метод FileSystemObject.GetFolder:

Sub Primer3()

Dim myPath As String, myFolder As Folder, myFile As File, n As Integer

'Записываем в переменную myPath полное имя папки

myPath = "C:\Users\Evgeniy\Desktop\Новая папка"

'Создаем новый экземпляр FileSystemObject

Dim fso As New FileSystemObject

'Присваиваем переменной myFolder ссылку на объект Folder

Set myFolder = fso.GetFolder(myPath)

'Проверяем, есть ли файлы в папке myFolder

If myFolder.Files.Count = 0 Then

MsgBox "В папке «" & myPath & "» файлов нет"

Exit Sub

End If

'Записываем номер по порядку в первый столбец активного листа,

'имя файла - во второй столбец,

'дату изменения файла - в третий столбец.

For Each myFile In myFolder.Files

n = n + 1

Cells(n + 1, 1) = n

Cells(n + 1, 2) = myFile.Name

Cells(n + 1, 3) = FileDateTime(myFile.Path)

'Заполняем строку заголовков

With Cells(1, 1)

.Value = "№ п/п"

'Автоподбор ширины столбца

.EntireColumn.AutoFit

'Полужирное начертание

.Font.Bold = True

'Выравнивание значения по центру

.HorizontalAlignment = xlCenter

End With

With Cells(1, 2)

.Value = "Имя"

.EntireColumn.AutoFit

.Font.Bold = True

.HorizontalAlignment = xlCenter

End With

With Cells(1, 3)

.Value = "Дата"

.EntireColumn.AutoFit

.Font.Bold = True

.HorizontalAlignment = xlCenter

'Добавляем границы ячеек

.CurrentRegion.Borders.LineStyle = True

End With

End Sub

Результат работы кода:

Если сравнить дату и время изменения файлов в папке проводника и в таблице Excel, то можно заметить, что время изменения файла «Certificate.pdf» разнится на 1 час. Непонятно, почему это происходит, так как в свойствах файла также указано время изменения, как в папке проводника:

Именно из-за этого случая я добавил словосочетание как правило в утверждение, что функция FileDateTime возвращает дату и время, которые отображаются в папке проводника справа от выбранного файла в столбце «Дата изменения» или «Дата», что означает — возможны исключения.

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.

14 комментариев для “VBA Excel. Функция FileDateTime”

Константин 10.09.2022 в 01:48

Спасибо!
Попробую и отвечу обязательно.
Константин 10.09.2022 в 12:55

Добрый день!
Воспользовался Вашим примером Нр 3.
Вставил код в лист, заменил полное имя, нажал проверить, а он ругается, выделяет "..., myFolder As Folder..." и "Sub Primer3()"
Что-то не так я сделал?
1. Евгений 10.09.2022 в 14:23
  
  Добрый день!
  Подключите библиотеку Microsoft Scripting Runtime (Tools >> References…).
Константин 10.09.2022 в 19:59

Вечер добрый, Евгений!
Библиотеку Microsoft Scripting Runtime (Tools >> References…) не подключал, т.к. побоялся что в школьных ПК с этим будет проблема.
Получил результат, как у Вас показано на картинке в результате работы кода, но только с небольшими изменениями. Правильно это или нет не знаю, но работает.
Изменил в строках:

1
2
3

Dim myPath As String, myFolder As Object, myFile As Object, n As Integer
и
Set fso = CreateObject("Scripting.FileSystemObject")

остальное в коде все осталось как у Вас в примере 3.
Это все здорово, но к нужному результату Я не продвинулся.
Как можно дополнить код, чтобы при обновлении даты (время) изменялся цвет ячейки (либо строки).
Это для того, чтобы было видно, какие файлы обновлены (изменены), а при нажатии на Имя файла (к каждому файлу будет привязана гиперссылка), цвет ячейки (либо строки) должен поменяться в исходное положение.
Вот, как то так.
Что-то придумать можно?

Евгений 11.09.2022 в 09:39

Константин, замените

1	Cells(n + 1, 3) = FileDateTime(myFile.Path)

на

If Cells(n + 1, 3) <> 0 And Cells(n + 1, 3) <> FileDateTime(myFile.Path) Then

Cells(n + 1, 3) = FileDateTime(myFile.Path)

Cells(n + 1, 3).Interior.Color = vbYellow

Else

Cells(n + 1, 3) = FileDateTime(myFile.Path)

End If

А в модуль листа добавьте:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 2 And Target.Offset(0, 1).Interior.Color = vbYellow Then

Target.Offset(0, 1).Interior.Color = xlNone

End If

End Sub

1. Константин 11.09.2022 в 17:08
  
  Евгений!
  В Книгу записал код, чтобы при открытии записанный код уже сработал. Правильно записал?
  
  1
  2
  3
  
  Private Sub Workbook_Open()
  Call Primer3
  End Sub

Константин 11.09.2022 в 16:16

Евгений, Вы супер МОЛОДЕЦ!
Код работает согласно пожеланий.

Еще один штрих добавить, если можно.
При запуске файла чтобы сработал этот код.
Константин 11.09.2022 в 17:25

Евгений!
В определенную папку от исполнителей собираются файлы с постоянными именами.
Вы написали код, который нам подошел.
Теперь нам видно какие файлы обновились, далее мы нажимаем на гиперссылку данного файла, он открывается, данные таким способом обновляются, закрываем и работаем далее с основным документом (куда стекаются все данные).

Чтобы данные обновлялись БЕЗ открытия файлов, это реальность или фантастика, подскажите пожалуйста!
1. Евгений 12.09.2022 в 00:13
  
  Для этого можно в ячейки, которые обновляются из закрытой книги, вставить формулы с указанием адреса книги:
  
  1
  
  ='C:\Users\Evgeniy\Desktop\[Отчет.xlsx]Лист1'!A1
  
  Можно набрать знак =, выбрать ячейку в другой книге и нажать галочку ввода формулы. После закрытия другой книги, ее адрес добавится в формулу автоматически.

Константин 13.09.2022 в 14:07

Добрый день Евгений!
Вы помогли с написанием кода. Работает он согласно пожеланий, но слишком долго открывается, если к нему прикрепить гиперссылку. Отдельным файлом работает быстро хорошо. Может есть вариант улучшить быстродействие по открытию этого файла через гиперссылку.

Код в Книге

Option Explicit

Private Sub Workbook_Open()

Обнови

End Sub

Код на Листе

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 2 And Target.Offset(0, 1).Interior.Color = vbYellow Then

Target.Offset(0, 1).Interior.Color = xlNone

End If

End Sub

Код в Модуле

Sub Обнови()

Dim myPath As String, myFolder As Object, myFile As Object, n As Integer

'Записываем в переменную myPath полное имя папки

myPath = "D:\Гимназия_17\Платные услуги\ФИО_учащихся_1_11"

'Создаем новый экземпляр FileSystemObject

Set fso = CreateObject("Scripting.FileSystemObject")

'Присваиваем переменной myFolder ссылку на обьект Folder

Set myFolder = fso.GetFolder(myPath)

'Проверяем, есть ли файлы в папке myFolder

If myFolder.Files.Count = 0 Then

MsgBox "В папке «" & myPath & "» файлов нет"

Exit Sub

End If

'Записываем

' номер по порядку - первый столбец активного листа,

' имя файла - второй столбец,

'дату изменения файла - третий столбец.

For Each myFile In myFolder.Files

n = n + 1

Cells(n + 1, 1) = n

Cells(n + 1, 2) = myFile.Name

'Cells(n + 1, 3) = FileDateTime(myFile.Path)

If Cells(n + 1, 3) <> 0 And Cells(n + 1, 3) <> FileDateTime(myFile.Path) Then

Cells(n + 1, 3) = FileDateTime(myFile.Path)

Cells(n + 1, 3).Interior.Color = vbYellow

Else

Cells(n + 1, 3) = FileDateTime(myFile.Path)

End If

'Заполняем строку заголовков

With Cells(1, 1)

.Value = "№ п/п"

'Автоподбор ширины столбца

.EntireColumn.AutoFit

'Полужирное начертание

.Font.Bold = True

'Выравнивание значения по центру

.HorizontalAlignment = xlCenter

End With

With Cells(1, 2)

.Value = "Имя"

.EntireColumn.AutoFit

.Font.Bold = True

.HorizontalAlignment = xlCenter

End With

With Cells(1, 3)

.Value = "Дата"

.EntireColumn.AutoFit

.Font.Bold = True

.HorizontalAlignment = xlCenter

'Добавляем границы ячеек

.CurrentRegion.Borders.LineStyle = True

End With

End Sub

1. Евгений 13.09.2022 в 21:41
  
  Здравствуйте, Константин!
  Подключите временно библиотеку Microsoft Scripting Runtime. Сначала проверьте код как есть. Если не поможет, примените раннюю привязку объектов, как было у меня в примере. Если и это не поможет, тогда не знаю как ускорить.
Константин 13.09.2022 в 22:19

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

1
2
3
4

Option Explicit
     Private Sub Workbook_Open()
         Обнови
     End Sub

то файл запускается через гиперссылку быстро. Однако если разместить кнопку на Листе с кодом, то код работает ещё медленнее.
Без гиперссылок, все хорошо, вопросов нет.

Может есть другой выход?
Пожелания кода выдумывались для такой схемы:
Отчет1.xlsm -> Книга1.xls -> Книга1.xls -> Учёт.xls
У исполнителя два файла Отчет1.xlsm, Книга1.xls.
У меня два файла Книга1.xls, Учёт.xls.
Исполнитель: в Книга1.xls из Отчет1.xlsm данные поступают методом =…
Далее файл Книга1.xls исполнитель отправляет по Эл.почте мне. Я его закидываю в определённую папку с таким же именем с заменой.
Далее данные из Книга1.xls должны отобразится в основном файле Учёт.xls методом =…
Вот тут то и засада. Если у себя полученный файл не открою, данные не обновляются.
Поэтому такой код и собирали.
Может что-то или как-то переиграть с кодом?
Спасибо!
1. Евгений 14.09.2022 в 19:16
  
  К сожалению, у меня нет решения.
2. 1. Константин 14.09.2022 в 19:18
    
    Все равно, огромное Вам спасибо. И так во многом помогли.
    Спасибо!

Обсуждение закрыто.