Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Workbooks & FileSystem


Rambler's Top100


Counter CO.KZ


    [1] [2] [3]

  1. Как быстро перейти в модуль книги ThisWorkbook(ЭтаКнига) ? NEW 19.09.2016
  2. Как найти и открыть файл, если известна только часть его имени ? NEW 03.07.2016
  3. Как найти файл с самой последней датой изменения ? NEW 27.08.2016
    [1] [2] [3]


  • Ответ : Актуально для MS Excel 97-2003

    Если Вам необходимо быстро перейти в модуль книги ThisWorkbook (в руссифицированном офисе, начиная с версии 2000, этот модуль называется ЭтаКнига), то подведите курсор мышки к иконке, которая располагается в самом начале панели инструментов Строка меню листа. Затем, нажмите на правую кнопку мышки, и в появившемся контекстном меню выберите команду Исходный текст.
  • Ответ :

    Если перед нами поставлена задача - найти в конкретной папке рабочую книгу, имя которой известно лишь частично, то для её решения, мы можем использовать VB(A) функцию Dir , которая позволяет применять символы подстановки ? и *

    Например, нам нужно найти файл, имя которого состоит всего из трёх символов (не учитывая расширение) и нам уже известны первый к и третий(последний) т , т.е. "кот.xls", "кит.xls" или "к1т.xls" , тогда :
  • Dim iPath$, iFileName$
    iPath = "C:\Папка где ищем файл\" 'Завершающий слэш обязателен
    iFileName = Dir(iPath & "к?т.xls")
        
    If iFileName <> "" Then 'If Len(iFileName) > 0
       MsgBox iFileName 'Здесь будет открытие файла
    Else
       MsgBox "Ничего подходящего не найдено"
    End If
    Если же необходимо найти файл, имя которого, начинается с к, а заканчивается на т , т.е. "кот.xls", "кит.xls", "корт.xls", "ковёр-самолёт.xls" или даже просто "кт.xls"
    Dim iPath$, iFileName$
    iPath = "C:\Папка где ищем файл"
    iFileName = Dir(iPath & "\к*т.xls")
        
    If iFileName <> "" Then 'If Len(iFileName) > 0
       MsgBox iFileName 'Здесь будет открытие файла
    Else
       MsgBox "Ничего подходящего не найдено"
    End If
    Для поиска файла, имя которого начинается, допустим, с "Январь", можно использовать
    iFileName = Dir(iPath & "\Январь*.xls")
    а если имя заканчивается на "2006", то
    iFileName = Dir(iPath & "\*2006.xls")
    Комментарий : Если в указанной папке будет несколько файлов, имена которых удовлетворяют поставленному условию, то для работы со всеми этими файлами, следует повторно вызвать функцию Dir, но уже без аргумента. Для примера, рассмотрим поиск всех файлов, имена которых должны начинаться с "Отчёт_отдела_" дальше ID отдела, который всегда содержит шесть символов, и заканчивается имя на "_2006.xls", где "2006" это текущий год, а "xls" это расширение файла.

    Перечень файлов, которые нам необходимы :

    "Отчёт_отдела_178521_2006.xls"
    "Отчёт_отдела_542987_2006.xls"
    "Отчёт_отдела_222278_2006.xls"

    Перечень файлов, которые находятся в той же папке, но их нужно игнорировать :

    "Отчёт_годовой_2006.xls"
    "Отчёт_отдела_117_2006.xls"
    "Отчёт_отдела_251_2006.xls"
    Private Sub Example8_Dir()
        iPath$ = "C:\Архив\Отчёты" 'Укажите свою папку
        iFileName$ = Dir(iPath$ & "\Отчёт_отдела_??????_" & Year(Now) & ".xls")
    
        Do Until iFileName$ = ""
           MsgBox iFileName$
           iFileName$ = Dir
        Loop
    End Sub

  • Ответ :

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

    Вариант I.
  • Private Sub FindLastDTFile()
        Dim iPath$, iFileName1$, iFileName2$
        Dim tmpDT As Date, tmpFileDT As Date
    
        iPath = "C:\Мои документы\Архив_2004\" 'Слэш обязателен
        iFileName1 = Dir(iPath)
    
        Do While iFileName1 <> ""
           tmpFileDT = FileDateTime(iPath & iFileName1)
           If tmpDT < tmpFileDT Then
              tmpDT = tmpFileDT: iFileName2 = iFileName1
           End If
           iFileName1 = Dir
        Loop
    
        MsgBox "Искомый файл = " & iFileName2
    End Sub
    Комментарий : Если Вы укажите несуществующую папку и/или забудете использовать завершающий слэш \ , то в результате получите пустую строку ""

    Вариант II.
    Private Sub FindLastDTFile2()
        Dim iPath$, iFileName$, iFile As Object
        Dim tmpDT As Date, tmpFileDT As Date
    
        iPath = "C:\Мои документы\Архив_2005" 'Слэш не обязателен
        
        With CreateObject("Scripting.FileSystemObject")
             For Each iFile In .GetFolder(iPath).Files
                 tmpFileDT = iFile.DateLastModified
                 If tmpDT < tmpFileDT Then
                    tmpDT = tmpFileDT: iFileName = iFile.Name
                 End If
             Next
        End With
    
        MsgBox "Искомый файл = " & iFileName
    End Sub
    Комментарий : Если Вы укажите несуществующую папку, то получите ошибку, которую можно избежать, если непосредственно перед перебором файлов, просто проверить наличие этой папки [FAQ287]
    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff