Создание макроса по поиску файла

[Никита Борисёнок]

Здраствуйте.
Подскажите возможно написать макрос который будет выполнять следующее :
есть архив договоров(pdf),есть xls опись данных договоров,необходимо добавить к каждому договор гиперссылку.
В первых двух ячейках в xls файле содержится номер полки и номер места,в сканах тоже содержится данная информация(пример 45_1344 ооо ромашка.pdf).можно сделать макрос который будет соединять номер полки и места и искать его среди файлов при удволетворительно результате проставлял гиперсcылку.

Пример:необходимо взять значение из столбцов А и Б соединить их символом "_"(получится результат 42_1369) начать поиск в папке и ее подпапках при нахождение файла который в название содежит данные (42_1369 например) запишет в ячейку гиперссылку на данный PDF документ
 

[Serge 007]

Здравствуйте

Да, можно, но думаю что вряд ли кто-то возьмется писать такой макрос просто из спортивного интереса...

[Никита Борисёнок]

Давайте писать вместе это же так интересно)))

Код Выделить Развернуть

Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                             Optional ByVal SearchDeep As Long = 999) As Collection
    ' Получает в качестве параметра путь к папке FolderPath,
    ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
    ' Возвращает коллекцию, содержащую полные пути найденных файлов
    ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

    Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
    Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function

Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                                 ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
    ' перебор папок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных файлов в коллекцию FileNamesColl
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке

        ' раскомментируйте эту строку для вывода пути к просматриваемой
        ' в текущий момент папке в строку состояния Excel
        ' Application.StatusBar = "Поиск в папке: " & FolderPath

        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
            If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path                              - Как указать переменную из столбцов А и B чтоб маска получилась= А+ "_" + B=A_B
        Next
        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
        If SearchDeep Then    ' если надо искать глубже
            For Each sfol In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
                GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If
End Function

[RAN]

Маска задается в не в функции, а в

Код Выделить Развернуть

Sub ЗагрузкаСпискаФайлов()
В том же месте был и макрос для формирования гиперссылок.