Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создание гиперссылок на файлы по неполному названию (поиск) - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание гиперссылок на файлы по неполному названию (поиск)
Создание гиперссылок на файлы по неполному названию (поиск)
aipeshya Дата: Среда, 23.11.2016, 16:09 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Здравствуйте ребята,

Опишу вам кратко мою ситуацию.
Есть у меня таблица с документами (название в колонке А) и мне необходимо в колонке (Б) ссылку на файл, который находится на диске.
Есть одна особенность, что файлы, которые сохранены на диске могут иметь не точно такое же название, как в таблице.
Вручную делать либо через формулу гиперссылки можно, но муторно, и плюс нужно знать точное название файла.

Хотелось бы облегчить процесс следующим образом:
Заполняем название документа в таблице, а в колонке рядом создается гиперссылка на файл, который находится на диске. Соответственно макросик сам пойдет сравнивать в папку на диске (в которой могут быть и подпапки), находит файл с почти таким же названием и дает ссылку.

Вот пример таблицы. Работаю в excel 2010, похожий код находила на 2003, но он не пашет в моей версии.

Заранее благодарна!! :)
К сообщению приложен файл: 8357275.xlsx (10.4 Kb)


Сообщение отредактировал aipeshya - Среда, 23.11.2016, 16:09
 
Ответить
СообщениеЗдравствуйте ребята,

Опишу вам кратко мою ситуацию.
Есть у меня таблица с документами (название в колонке А) и мне необходимо в колонке (Б) ссылку на файл, который находится на диске.
Есть одна особенность, что файлы, которые сохранены на диске могут иметь не точно такое же название, как в таблице.
Вручную делать либо через формулу гиперссылки можно, но муторно, и плюс нужно знать точное название файла.

Хотелось бы облегчить процесс следующим образом:
Заполняем название документа в таблице, а в колонке рядом создается гиперссылка на файл, который находится на диске. Соответственно макросик сам пойдет сравнивать в папку на диске (в которой могут быть и подпапки), находит файл с почти таким же названием и дает ссылку.

Вот пример таблицы. Работаю в excel 2010, похожий код находила на 2003, но он не пашет в моей версии.

Заранее благодарна!! :)

Автор - aipeshya
Дата добавления - 23.11.2016 в 16:09
Udik Дата: Среда, 23.11.2016, 16:46 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Вот основа, здесь используется папка файла с макросом.
[vba]
Код

Public Sub ssil()
Dim rng1 As Range, unoCell As Range
Dim rowLast As Long
Dim TheFolder, TheFiles, AFile, FSO

With ActiveSheet

rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder(ThisWorkbook.Path) ' папка где лежат все files
Set TheFiles = TheFolder.Files
For Each unoCell In rng1
For Each AFile In TheFiles
If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
.Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _
Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name
End If
Next AFile
Next unoCell
End With
End Sub
[/vba]
К сообщению приложен файл: 2689168.xlsm (18.8 Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Среда, 23.11.2016, 18:42
 
Ответить
СообщениеВот основа, здесь используется папка файла с макросом.
[vba]
Код

Public Sub ssil()
Dim rng1 As Range, unoCell As Range
Dim rowLast As Long
Dim TheFolder, TheFiles, AFile, FSO

With ActiveSheet

rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder(ThisWorkbook.Path) ' папка где лежат все files
Set TheFiles = TheFolder.Files
For Each unoCell In rng1
For Each AFile In TheFiles
If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
.Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _
Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name
End If
Next AFile
Next unoCell
End With
End Sub
[/vba]

Автор - Udik
Дата добавления - 23.11.2016 в 16:46
aipeshya Дата: Среда, 23.11.2016, 17:52 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Вот основа, здесь используется папка файла с макросом.


Спасибо, но не работает, выдает ошибку type mismatch.
Я новичок в VBA, подскажите, пожалуйсте, только в fso.getfolder указать путь? :)


Сообщение отредактировал aipeshya - Среда, 23.11.2016, 18:02
 
Ответить
Сообщение
Вот основа, здесь используется папка файла с макросом.


Спасибо, но не работает, выдает ошибку type mismatch.
Я новичок в VBA, подскажите, пожалуйсте, только в fso.getfolder указать путь? :)

Автор - aipeshya
Дата добавления - 23.11.2016 в 17:52
Udik Дата: Среда, 23.11.2016, 18:00 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Спасибо, но не работает, ошибок не дает

В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.

только в fso.getfolder указать путь

Да


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
Спасибо, но не работает, ошибок не дает

В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.

только в fso.getfolder указать путь

Да

Автор - Udik
Дата добавления - 23.11.2016 в 18:00
aipeshya Дата: Среда, 23.11.2016, 18:03 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
В смысле не работает?

Выдал ошибку type mismatch.
 
Ответить
Сообщение
В смысле не работает?

Выдал ошибку type mismatch.

Автор - aipeshya
Дата добавления - 23.11.2016 в 18:03
Udik Дата: Среда, 23.11.2016, 18:12 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Вы файл запускаете который скачали, или код скопировали в свой и оттуда запускаете? Я прописал обработку активного листа, если лист будет "неправильный" могут быть сюрпризы.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеВы файл запускаете который скачали, или код скопировали в свой и оттуда запускаете? Я прописал обработку активного листа, если лист будет "неправильный" могут быть сюрпризы.

Автор - Udik
Дата добавления - 23.11.2016 в 18:12
aipeshya Дата: Среда, 23.11.2016, 18:15 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.


Гляньте, пожалуйста, мой макрос. Грузится, но ничего не происходит. Ошибок снова не дает.

[vba]
Код
Option Explicit

Public Sub ssil()
Dim rng1 As Range, unoCell As Range
Dim rowLast As Long
Dim TheFolder, TheFiles, AFile, FSO

With ActiveSheet

rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
foldername = "С:\Users\AA\Downloads"
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder(FolderName)
Set TheFiles = TheFolder.Files
For Each unoCell In rng1
For Each AFile In TheFiles
If AFile.Name Like "*" & unoCell.Value & "*.pdf" Then
.Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _
Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name
End If
Next AFile
Next unoCell
End With
End Sub
[/vba]


Сообщение отредактировал Pelena - Среда, 23.11.2016, 18:27
 
Ответить
Сообщение
В смысле не работает? Алгоритм такой: сравниваются имена файлов указанной папки с ячейками диапазона. Если имена из ячеек совпадают с частью имени файла, то имя файла вписывается в ячейку рядом как гиперссылка. Я у себя на тестовом файле проверил - макрос его выявил.


Гляньте, пожалуйста, мой макрос. Грузится, но ничего не происходит. Ошибок снова не дает.

[vba]
Код
Option Explicit

Public Sub ssil()
Dim rng1 As Range, unoCell As Range
Dim rowLast As Long
Dim TheFolder, TheFiles, AFile, FSO

With ActiveSheet

rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
foldername = "С:\Users\AA\Downloads"
Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder(FolderName)
Set TheFiles = TheFolder.Files
For Each unoCell In rng1
For Each AFile In TheFiles
If AFile.Name Like "*" & unoCell.Value & "*.pdf" Then
.Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _
Address:=TheFolder & "\" & AFile.Name, TextToDisplay:=TheFolder & "\" & AFile.Name
End If
Next AFile
Next unoCell
End With
End Sub
[/vba]

Автор - aipeshya
Дата добавления - 23.11.2016 в 18:15
Udik Дата: Среда, 23.11.2016, 18:25 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Вот эта строка
Цитата

Option Explicit

требует обязательного объявления переменных, объявления foldername не нашёл.
И второе: foldername и FolderName должны быть одинаково написаны. Обычно автоматически так происходит, если нет, то может какая ошибка имеется.

Сейчас поробую Ваш код у себя проверить.
==
добавил
[vba]
Код

Dim FolderName As String
[/vba]
нормально отработало.
еще одну строку чуть подправить надо.
[vba]
Код

If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
[/vba]


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Среда, 23.11.2016, 18:41
 
Ответить
СообщениеВот эта строка
Цитата

Option Explicit

требует обязательного объявления переменных, объявления foldername не нашёл.
И второе: foldername и FolderName должны быть одинаково написаны. Обычно автоматически так происходит, если нет, то может какая ошибка имеется.

Сейчас поробую Ваш код у себя проверить.
==
добавил
[vba]
Код

Dim FolderName As String
[/vba]
нормально отработало.
еще одну строку чуть подправить надо.
[vba]
Код

If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
[/vba]

Автор - Udik
Дата добавления - 23.11.2016 в 18:25
aipeshya Дата: Среда, 23.11.2016, 18:42 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
нормально отработало.


У меня не хочет почему-то, грузится, а потом ничего.
 
Ответить
Сообщение
нормально отработало.


У меня не хочет почему-то, грузится, а потом ничего.

Автор - aipeshya
Дата добавления - 23.11.2016 в 18:42
Udik Дата: Среда, 23.11.2016, 18:50 | Сообщение № 10
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Это надо пошагово проверять. Оставьте в папке 1-2 файла и проверьте каждый шаг. Или сделайте архив с папкой и эксель файлом, тогда я у себя смогу проверить.


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Среда, 23.11.2016, 18:52
 
Ответить
СообщениеЭто надо пошагово проверять. Оставьте в папке 1-2 файла и проверьте каждый шаг. Или сделайте архив с папкой и эксель файлом, тогда я у себя смогу проверить.

Автор - Udik
Дата добавления - 23.11.2016 в 18:50
aipeshya Дата: Четверг, 24.11.2016, 13:09 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Или сделайте архив с папкой и эксель файлом, тогда я у себя смогу проверить.


Udik, вот архив, ищу и не могу понять, в чем проблема %)
Спасибо Вам, что возитесь со мной :D
К сообщению приложен файл: Downloads.7z (94.7 Kb)


Сообщение отредактировал aipeshya - Четверг, 24.11.2016, 13:11
 
Ответить
Сообщение
Или сделайте архив с папкой и эксель файлом, тогда я у себя смогу проверить.


Udik, вот архив, ищу и не могу понять, в чем проблема %)
Спасибо Вам, что возитесь со мной :D

Автор - aipeshya
Дата добавления - 24.11.2016 в 13:09
Udik Дата: Четверг, 24.11.2016, 14:40 | Сообщение № 12
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Посмотрел - Вы лишний слеш оставили :)
Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша.
Ваш архивчик проверил - отловился Документ 2. Вроде правильно, остальных имён в именах файлов нет. Чуток подправил код.
[vba]
Код

Public Sub ssil()
Dim rng1 As Range, unoCell As Range
Dim rowLast As Long
Dim TheFolder, TheFiles, AFile, FSO
Dim FolderName As String

With ActiveSheet

rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\"
FolderName = "d:\Temp\download\книги\Downloads"

Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder(FolderName)
Set TheFiles = TheFolder.Files
For Each unoCell In rng1
For Each AFile In TheFiles
If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
.Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _
Address:=TheFolder.Path & "\" & AFile.Name, TextToDisplay:=TheFolder.Path & "\" & AFile.Name
End If
Next AFile
Next unoCell
End With
End Sub

[/vba]
Если не заработает, значит путь как-то неправильно записан. :)
К сообщению приложен файл: 5842196.xlsm (18.9 Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеПосмотрел - Вы лишний слеш оставили :)
Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша.
Ваш архивчик проверил - отловился Документ 2. Вроде правильно, остальных имён в именах файлов нет. Чуток подправил код.
[vba]
Код

Public Sub ssil()
Dim rng1 As Range, unoCell As Range
Dim rowLast As Long
Dim TheFolder, TheFiles, AFile, FSO
Dim FolderName As String

With ActiveSheet

rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\"
FolderName = "d:\Temp\download\книги\Downloads"

Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TheFolder = FSO.GetFolder(FolderName)
Set TheFiles = TheFolder.Files
For Each unoCell In rng1
For Each AFile In TheFiles
If (AFile.Name Like "*" & unoCell.Value & "*.pdf") And (unoCell.Value <> "") Then
.Hyperlinks.Add Anchor:=unoCell.Offset(0, 1), _
Address:=TheFolder.Path & "\" & AFile.Name, TextToDisplay:=TheFolder.Path & "\" & AFile.Name
End If
Next AFile
Next unoCell
End With
End Sub

[/vba]
Если не заработает, значит путь как-то неправильно записан. :)

Автор - Udik
Дата добавления - 24.11.2016 в 14:40
aipeshya Дата: Четверг, 24.11.2016, 15:37 | Сообщение № 13
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Посмотрел - Вы лишний слеш оставили
Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша.


Урааа, зарабооотало!!! :D :D :D

А еще вопрос, если название документа не в первой колонке и первой линии, а скажем 7 колонка и 5 линия, а ссылка должна быть в 25 колонке и 5 линии, где мне это указать?

[vba]
Код

Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))     'в этой линии кода надо изменить?'
[/vba]


Сообщение отредактировал aipeshya - Четверг, 24.11.2016, 15:40
 
Ответить
Сообщение
Посмотрел - Вы лишний слеш оставили
Надо ''FolderName = "C:\Users\hfm560\Downloads\Downloads.7z\" без конечного слеша.


Урааа, зарабооотало!!! :D :D :D

А еще вопрос, если название документа не в первой колонке и первой линии, а скажем 7 колонка и 5 линия, а ссылка должна быть в 25 колонке и 5 линии, где мне это указать?

[vba]
Код

Set rng1 = .Range(.Cells(2, 1), .Cells(rowLast, 1))     'в этой линии кода надо изменить?'
[/vba]

Автор - aipeshya
Дата добавления - 24.11.2016 в 15:37
Udik Дата: Четверг, 24.11.2016, 15:51 | Сообщение № 14
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
скажем 7 колонка и 5 линия,

Сейчас проверка идет по диапазону первого столбца от 2 строки до последней заполненной. Если надо брать из 1 ячейки, так:
[vba]
Код

Set rng1 = .Cells(5, 7)
[/vba]


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщение
скажем 7 колонка и 5 линия,

Сейчас проверка идет по диапазону первого столбца от 2 строки до последней заполненной. Если надо брать из 1 ячейки, так:
[vba]
Код

Set rng1 = .Cells(5, 7)
[/vba]

Автор - Udik
Дата добавления - 24.11.2016 в 15:51
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание гиперссылок на файлы по неполному названию (поиск)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!