Гиперссылки в ячейках

[JVG]

Добрый день, уважаемое сообщество!

Пытаясь найти решение одной задачи покопался по темам и в сообщении Дмидми (аж в 2008 году) нашел вариант, но к сожалению не могу его немного подпилить.
Вот весь код:
"Sub FileHyperlinks()
Dim SrcPath As String, FileName As String, FileExt, ExtList
Dim DstWb As Workbook

SrcPath = CurDir & Application.PathSeparator
ExtList = Array("rar", "zip", "txt") 'etc.

For Each FileExt In ExtList
FileName = Dir(SrcPath & "*." & FileExt _
, vbNormal + vbArchive + vbReadOnly)
Do While FileName <> ""
If DstWb Is Nothing Then
Set DstWb = Workbooks.Add(xlWBATWorksheet)
End If
ActiveCell.Offset(1, 0).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection _
, Address:=SrcPath & FileName _
, ScreenTip:=Format(Round( _
FileLen(SrcPath & FileName) / 1024)) & " KB" _
, TextToDisplay:=FileName
FileName = Dir
Loop
Next 'FileExt
End Sub"
В оригинале он записывает линки только архивных и текстовые файлов. Мне необходима такая же процедура но с jpg-ами и всего каталога с поддиректориями. Менял в макросе признаки - не работает.
Подскажите пожалуйста, как довести код под задачу?

[doober]

Из старых запасов
Сделаете под себя

[JVG]

doober, спасибо за ответ ! Немножко не то, к сожалению. Эту процедуру я простым батником проделываю, он прописывает в текстовый файл все jpg, находящиеся на диске, с полными путями. У дмидми же все это было реализовано в Excel'е. Конечная цель моих поисков -подтянуть в таблицы с остатками товаров их изображение. Наименование картинок соответствует наименованию артикулов. Макрос-единственный путь для решения задачи, т.к. картинок порядка 6000 шт......

[doober]

я думаю файл строк на 10,заполненных,+10 маленьких картинок с папками,как пример ускорит написание макроса.
Не люблю сочинять файлы и различные ситуации
Мне нужна картина результата.

[JVG]

doober, не вопрос, спасибо за отзывчивость!
В архиве файл-образец +текстовый файл с путями.
В файле прикручен макрос, который раскидывает выгрузку из 1С по остаткам и продажам артикулов по магазинам и складам.
В листах присутствуют линки, это все ручками долбилось.
Текстовый файл не обработан, дело в том, что батник пишет фактические пути на сервере, где каталог и расположен, ему по барабану шаринг.
После выгрузки исправляю все сам. В довесок приложил файлик xls с "правильными путями".

[doober]

Битый архив.

Recovery Toolbox for RAR не помог востановить

[JVG]

Прошу прощения, проверил, перелил.

[doober]

работает,если в пути нет пробелов,иначе ошибка

Sub FileHyperlinks()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim X1 As Range, X2 As Range, X3 As Range, F_Name As String, F_Link As String
F_Name = ThisWorkbook.Path
Set Sh1 = ThisWorkbook.Sheets(1)
Set Sh2 = ThisWorkbook.Sheets(2)
Set Sh3 = ThisWorkbook.Sheets(3)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim rez, s As String, IMG As String
Set Txt = oFSO.OpenTextFile(F_Name & "\tree.txt", 1, True)
On Error Resume Next
Do
    s = Txt.ReadLine
DoEvents
    rez = Split(s, "\", -1)
    F_Link = Replace(s, rez(0), "\")
    IMG = Split(rez(UBound(rez)), ".")(0)

    Set X1 = Sh1.Columns("B:B").Find(What:=IMG, LookAt:=xlWhole)
    If Not X1 Is Nothing Then
    Sh1.Hyperlinks.Add Anchor:=X1, Address:=F_Link
GoTo 10
    End If
    Set X2 = Sh2.Columns("B:B").Find(What:=IMG, LookAt:=xlWhole)
    If Not X2 Is Nothing Then
      Sh2.Hyperlinks.Add Anchor:=X2, Address:=F_Link
GoTo 10
    End If
    Set X3 = Sh3.Columns("B:B").Find(What:=IMG, LookAt:=xlWhole)
    If Not X3 Is Nothing Then
       Sh3.Hyperlinks.Add Anchor:=X3, Address:=F_Link
    End If
10
Loop While Err = 0

Txt.Close
Set Txt=Nothing:Set oFSO=Nothing
End Sub

[JVG]

doober, спасибо за помощь ! В понедельник буду пробовать.