[VBA][LibreOffice] Макрос вывода списка файлов определенной папки по маске

Напишем пример VBA программы в LibreOffice 6.4.4.2. Я уже писал о том, как написать простой макрос в этой статье. Перейдите по этой ссылке и посмотрите с чего начать. Наш макрос будет читать имена файлов в выбранной директории и выводить их в ячейки таблицы по определенной маске. Маска будет задаваться в коде макроса. Директория будет выбираться при помощи стандартного диалога Windows. Код сопровождается необходимыми комментариями, что бы понять работу макроса.

Рисунок 1. Результат работы макроса

Код макроса:

Sub Main
 Dim oFP As Object
 Dim DirName As String
 'Вызываем диалог выбора директории и сохраним путь папки в переменной DirName
 DirName = ""
 oFP = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
 oFP.DisplayDirectory = ConvertToURL("C:\")
 oFP.Description = "Select a directory"
 oFP.Title = "Select the backup directory"
 
 If oFP.execute = _
  com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
  DirName = oFP.Directory
 End If
 
    Dim TableHeaderRangeData(0, 2)
    Dim TableHeaderRangeObject as Object
    Dim MainDocument as Object 
    MainDocument = ThisComponent
    'Очистим весь контент
    MainDocument.CurrentSelection.ClearContents(1 OR 2 OR 4 OR 8 OR 16 OR 32 OR 64 OR 128 OR 256 OR 512)
    'Сформируем заголовки таблицы (Сканируемая папка, Фильтр, Список файлов)
    TableHeaderRangeData(0, 0) = "Scan Folder"
    TableHeaderRangeData(0, 1) = "Filter"
    TableHeaderRangeData(0, 2) = "List Files"
 
    TableHeaderRangeObject = MainDocument.Sheets(0).getCellRangebyName("A1:C1")
    TableHeaderRangeObject.charWeight = com.sun.star.awt.FontWeight.BOLD
    TableHeaderRangeObject.setDataArray(TableHeaderRangeData)
 'Сформируем маску
 ReDim TableHeaderRangeData(0, 1)
 Dim strMaskSearch as String
 strMaskSearch = "*.pdf*"
 'Выведем путь папки и фильтр в ячейки таблицы
 TableHeaderRangeData(0, 0) = DirName
    TableHeaderRangeData(0, 1) = strMaskSearch 
 TableHeaderRangeObject = MainDocument.Sheets(0).getCellRangebyName("A2:B2") 
 TableHeaderRangeObject.charWeight = com.sun.star.awt.FontWeight.NORMAL
 TableHeaderRangeObject.setDataArray(TableHeaderRangeData)
 'Выведем список файлов в ячейки таблицы
 Dim FileName As String
 Dim iCounter As Integer
 FileName = Dir(DirName & "/" & strMaskSearch, 0)
 iCounter = 0
 Do While (FileName <> "")
     iCounter = iCounter + 1
 
  MainDocument.Sheets(0).getCellByPosition(2,iCounter).String = ""
     MainDocument.Sheets(0).getCellByPosition(2,iCounter).String = FileName
     FileName = Dir()
 Loop
End Sub