Используйте дату, найденную в имени файла, для обновления конкретного элемента управления датой

Question

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

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

Ниже приведенный макрос — это моя попытка сделать то, что я хочу. Единственная проблема в том, что он не учитывает пятую (то есть последнюю) встречу дня недели в месяце, если их больше четырех (4). Кроме того, я задаюсь вопросом, как сделать так, чтобы это был четвертый экземпляр в некоторых случаях или просто последний экземпляр. Если у меня может быть только один, я бы выбрал последний экземпляр:

Sub UpdateNextMeetingDate()
    Dim cc As ContentControl
    Dim docName As String
    Dim fileDate As Date
    Dim dayOfWeek As String
    Dim occurrence As Integer
    Dim nextMonthDate As Date
    Dim formattedDate As String
    Dim datePattern As Object
    Dim matches As Object

    ' Получить имя документа без полного пути
    docName = ActiveDocument.Name

    ' Использовать регулярные выражения для извлечения даты формата мм-дд-гг из имени файла
    Set datePattern = CreateObject("VBScript.RegExp")
    datePattern.Pattern = "\b(\d{2})-(\d{2})-(\d{2})\b"
    datePattern.IgnoreCase = True
    datePattern.Global = False
    
    ' Проверить, соответствует ли имя файла шаблону
    If datePattern.Test(docName) Then
        Set matches = datePattern.Execute(docName)
        ' Извлечь совпавшие компоненты даты
        With matches(0)
            ' Преобразовать в дату, используя формат мм-дд-гг
            fileDate = DateSerial("20" & .SubMatches(2), .SubMatches(0), .SubMatches(1))
        End With
        
        ' Определить день недели и порядковый номер в месяце
        dayOfWeek = Format(fileDate, "dddd")
        occurrence = GetWeekdayOccurrence(fileDate)
        
        ' Найти тот же день недели и порядковый номер в следующем месяце
        nextMonthDate = GetNthWeekdayInNextMonth(fileDate, Weekday(fileDate), occurrence)
        
        ' Отформатировать финальную строку даты
        formattedDate = Format(nextMonthDate, "dddd, mmmm d, yyyy")
        
        ' Искать элемент управления с заголовком "Дата следующей встречи"
        For Each cc In ActiveDocument.ContentControls
            If cc.Title = "Next Meeting Date" Then
                ' Установить новое значение для элемента управления
                cc.Range.Text = formattedDate
                Exit For  ' Выйти после нахождения и обновления управления
            End If
        Next cc
    Else
        MsgBox "Дата не найдена в имени файла в формате мм-дд-гг.", vbExclamation
    End If
End Sub

' Вспомогательная функция для определения порядкового номера дня недели в месяце
Function GetWeekdayOccurrence(d As Date) As Integer
    Dim counter As Integer
    Dim i As Integer
    counter = 0
    For i = 1 To Day(d)
        If Weekday(DateSerial(Year(d), Month(d), i)) = Weekday(d) Then
            counter = counter + 1
        End If
    Next i
    GetWeekdayOccurrence = counter
End Function

' Вспомогательная функция для получения n-го дня недели следующего месяца
Function GetNthWeekdayInNextMonth(d As Date, targetWeekday As Integer, occurrence As Integer) As Date
    Dim targetDate As Date
    Dim currentOccurrence As Integer
    Dim i As Integer
    currentOccurrence = 0
    
    ' Установить targetDate на 1-е число следующего месяца
    targetDate = DateSerial(Year(d), Month(d) + 1, 1)
    
    ' Цикл по каждому дню следующего месяца для поиска целевого дня недели и порядкового номера
    For i = 1 To 31
        On Error Resume Next  ' Обработка случаев, когда даты превышают количество дней в месяце
        targetDate = DateSerial(Year(d), Month(d) + 1, i)
        If Weekday(targetDate) = targetWeekday Then
            currentOccurrence = currentOccurrence + 1
            If currentOccurrence = occurrence Then
                GetNthWeekdayInNextMonth = targetDate
                Exit Function
            End If
        End If
        On Error GoTo 0
    Next i
End Function

Используйте дату, найденную в имени файла, для обновления конкретного элемента управления датой

Вопрос или проблема

Ответ или решение

Использование даты из имени файла для обновления определённого поля управления датой

Введение

Цели и задачи

Пример кода

Объяснение кода

Заключение