Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpBI As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
Const BIF_RETURNONLYFSDIRS = 1, MAX_PATH = 260
Dim intNull As Integer, lngIdList As Long
Dim udtBI As BrowseInfo
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = sPrompt
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lngIdList = SHBrowseForFolder(udtBI)
If lngIdList Then
strPath = String$(MAX_PATH, 0)
SHGetPathFromIDList lngIdList, strPath
CoTaskMemFree lngIdList
intNull = InStr(strPath, vbNullChar)
If intNull Then
strPath = Left$(strPath, intNull - 1)
End If
End If
BrowseForFolder = strPath
End Function
Private Sub Command1_Click()
Call BrowseForFolder(Me.hWnd, "Выберете каталог")
End Sub
Гиперccылки в excel
Я ничего не понимаю в программировании, но сложно ли создать программку, которая бы создавала гиперссылки в excel по отдельности на все файлы содержащиеся в указанной мною папке?
Т.е я указываю папку и в столбце таблицы начиная с текущей ячейки появляются гиперссылки на все файлы которые эта папка содержит, с указанием в ячейке только названий этих файлов.
Т.е я указываю папку и в столбце таблицы начиная с текущей ячейки появляются гиперссылки на все файлы которые эта папка содержит, с указанием в ячейке только названий этих файлов.
Цитата:
Originally posted by Апельсинов
Я ничего не понимаю в программировании, но сложно ли создать программку, которая бы создавала гиперссылки в excel по отдельности на все файлы содержащиеся в указанной мною папке?
Т.е я указываю папку и в столбце таблицы начиная с текущей ячейки появляются гиперссылки на все файлы которые эта папка содержит, с указанием в ячейке только названий этих файлов.
Я ничего не понимаю в программировании, но сложно ли создать программку, которая бы создавала гиперссылки в excel по отдельности на все файлы содержащиеся в указанной мною папке?
Т.е я указываю папку и в столбце таблицы начиная с текущей ячейки появляются гиперссылки на все файлы которые эта папка содержит, с указанием в ячейке только названий этих файлов.
Да нет, не сложно. Самое трудно здесь как это ни странно - вывод станд. диалога выбора папок, посколько такого контрола нет и надо использовать API'шную функцию (у меня даже где-то примерчик был).
Цитата:
Originally posted by SergeySV
Да нет, не сложно. Самое трудно здесь как это ни странно - вывод станд. диалога выбора папок, посколько такого контрола нет и надо использовать API'шную функцию (у меня даже где-то примерчик был).
Да нет, не сложно. Самое трудно здесь как это ни странно - вывод станд. диалога выбора папок, посколько такого контрола нет и надо использовать API'шную функцию (у меня даже где-то примерчик был).
А я в таких случаях ставлю диалог выбора любого файла в папке, а затем имя файла отбрасываю. Погоди, напишу тебе такую программку.
Цитата:
Originally posted by Cutty Sark
А я в таких случаях ставлю диалог выбора любого файла в папке, а затем имя файла отбрасываю. Погоди, напишу тебе такую программку.
А я в таких случаях ставлю диалог выбора любого файла в папке, а затем имя файла отбрасываю. Погоди, напишу тебе такую программку.
Да, я тоже так раньше делал, пока не натолкнулся на такого симпатягу:
Код:
Господа, я конечно удручен своей безграмотностью в этом вопросе, но очень хотелось бы знать что это за "симпатяга", как это может помочь мне, и каким образом все это использовать?
Цитата:
Originally posted by Апельсинов
Господа, я конечно удручен своей безграмотностью в этом вопросе, но очень хотелось бы знать что это за "симпатяга", как это может помочь мне, и каким образом все это использовать?
Господа, я конечно удручен своей безграмотностью в этом вопросе, но очень хотелось бы знать что это за "симпатяга", как это может помочь мне, и каким образом все это использовать?
Неее, это не тебе.
т.е. тебе но это только кусочек, так, всякие украшательства.
Завтра тебе напишем простой алгоритм (без этого крокодила)... :)
Вот готовый макрос.
Скопируй его в какой-нибудь модуль (если модуль книги Personal.xls, то он будет всегда доступен в Excel'е)
и запусти макрос AddHyperlinksToFile (через меню: Сервис/Макрос/Макросы... или нажав Alt+F8)
Скопируй его в какой-нибудь модуль (если модуль книги Personal.xls, то он будет всегда доступен в Excel'е)
и запусти макрос AddHyperlinksToFile (через меню: Сервис/Макрос/Макросы... или нажав Alt+F8)
Код:
Sub AddHyperlinksToFile()
Dim sfileToOpen As String ' путь к выбранному файлу
Dim sPathDir As String ' путь до директории
Dim fileList() As String ' массив с именами и путями файлов
Dim sFile As String ' имя файла
Dim iMax As Integer ' кол-во файлов в дир.
Dim iRow As Integer, iCol As Integer ' номер строки и столбца куда будем писать
Dim i As Integer
On Error GoTo Err_
' открываем ст. диалог выбора файла
sfileToOpen = Application.GetOpenFilename("Все файлы (*.*), *.*", , "Выберите любой файл из нужной директории.", , False)
' получаем путь до папки (откидываем наз. файла)
sPathDir = DirWithoutFile(sfileToOpen)
' получаем массив файлов из указанной папки
sFile = Dir(sPathDir, vbDirectory)
' опред. кол-во файлов в дир.
Do While Len(sFile) > 0
' игнорируем тек. дир. и верхн. дир.
If sFile <> "." And sFile <> ".." Then _
iMax = iMax + 1
sFile = Dir
Loop
' инициализируем массив для имен файлов
ReDim fileList(1 To iMax)
' заполняем массив
i = 1
sFile = Dir(sPathDir, vbDirectory)
Do While Len(sFile) > 0
' игнорируем тек. дир. и верхн. дир.
If sFile <> "." And sFile <> ".." Then
fileList(i) = sFile ' полный путь к файлу
i = i + 1
End If
sFile = Dir
Loop
' заполняем активный лист Excel'а
iRow = 1 ' начинаем с 1 строки (можно менять, :-) )
iCol = 1 ' пишем в 1 столбец (можно менять, :-) )
For i = 1 To UBound(fileList)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, iCol), Address:= _
sPathDir & fileList(i), TextToDisplay:=fileList(i)
iRow = iRow + 1
Next i
Ex_:
Exit Sub
Err_:
MsgBox Err.Description
Resume Ex_
End Sub
Dim sfileToOpen As String ' путь к выбранному файлу
Dim sPathDir As String ' путь до директории
Dim fileList() As String ' массив с именами и путями файлов
Dim sFile As String ' имя файла
Dim iMax As Integer ' кол-во файлов в дир.
Dim iRow As Integer, iCol As Integer ' номер строки и столбца куда будем писать
Dim i As Integer
On Error GoTo Err_
' открываем ст. диалог выбора файла
sfileToOpen = Application.GetOpenFilename("Все файлы (*.*), *.*", , "Выберите любой файл из нужной директории.", , False)
' получаем путь до папки (откидываем наз. файла)
sPathDir = DirWithoutFile(sfileToOpen)
' получаем массив файлов из указанной папки
sFile = Dir(sPathDir, vbDirectory)
' опред. кол-во файлов в дир.
Do While Len(sFile) > 0
' игнорируем тек. дир. и верхн. дир.
If sFile <> "." And sFile <> ".." Then _
iMax = iMax + 1
sFile = Dir
Loop
' инициализируем массив для имен файлов
ReDim fileList(1 To iMax)
' заполняем массив
i = 1
sFile = Dir(sPathDir, vbDirectory)
Do While Len(sFile) > 0
' игнорируем тек. дир. и верхн. дир.
If sFile <> "." And sFile <> ".." Then
fileList(i) = sFile ' полный путь к файлу
i = i + 1
End If
sFile = Dir
Loop
' заполняем активный лист Excel'а
iRow = 1 ' начинаем с 1 строки (можно менять, :-) )
iCol = 1 ' пишем в 1 столбец (можно менять, :-) )
For i = 1 To UBound(fileList)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, iCol), Address:= _
sPathDir & fileList(i), TextToDisplay:=fileList(i)
iRow = iRow + 1
Next i
Ex_:
Exit Sub
Err_:
MsgBox Err.Description
Resume Ex_
End Sub
Да, чуть не забыл.
Вспомогательную функцию тоже рядом с макросом брось:
Вспомогательную функцию тоже рядом с макросом брось:
Код:
Public Function FileWithoutDir(path As String) As String
' Вырезает название файла из полного пути к файлу
Dim i%, pos%
On Error GoTo Err_
FileWithoutDir = ""
s = ""
If path <> "" Then
pos = InStr(1, path, "\")
s = path
If pos > 0 Then
Do
s = Right(s, Len(s) - pos)
pos = InStr(1, s, "\")
Loop Until pos = 0
End If
FileWithoutDir = s
End If
ExitSub:
Exit Function
Err_:
MsgBox "Возникла ошибка! (в функ. FileWithoutDir)"
Resume ExitSub
End Function
' Вырезает название файла из полного пути к файлу
Dim i%, pos%
On Error GoTo Err_
FileWithoutDir = ""
s = ""
If path <> "" Then
pos = InStr(1, path, "\")
s = path
If pos > 0 Then
Do
s = Right(s, Len(s) - pos)
pos = InStr(1, s, "\")
Loop Until pos = 0
End If
FileWithoutDir = s
End If
ExitSub:
Exit Function
Err_:
MsgBox "Возникла ошибка! (в функ. FileWithoutDir)"
Resume ExitSub
End Function
Блин, вот что значит на обед уже пора, перепутал функцию, в макросе используется обратная - DirWithoutFile, вот ее код:
Код:
Public Function DirWithoutFile(path As String) As String
' Вырезает путь до файла
Dim i%, pos%
On Error GoTo Err_
DirWithoutFile = ""
If path <> "" Then
i = InStr(1, path, "\", vbTextCompare)
Do While i > 0
pos = i
i = InStr(pos + 1, path, "\", vbTextCompare)
Loop
DirWithoutFile = Left(path, pos)
End If
ExitSub:
Exit Function
Err_:
MsgBox "Возникла ошибка! (в функ. DirWithoutFile)"
Resume ExitSub
End Function
' Вырезает путь до файла
Dim i%, pos%
On Error GoTo Err_
DirWithoutFile = ""
If path <> "" Then
i = InStr(1, path, "\", vbTextCompare)
Do While i > 0
pos = i
i = InStr(pos + 1, path, "\", vbTextCompare)
Loop
DirWithoutFile = Left(path, pos)
End If
ExitSub:
Exit Function
Err_:
MsgBox "Возникла ошибка! (в функ. DirWithoutFile)"
Resume ExitSub
End Function
:) Здорово!!! Большое спасибо!!!
С трудом, но я все таки запустил этот макрос, вот только что такое Personal.xls - у меня такого файла нет, и можно ли сделать чтобы он был доступен в excel всегда,и прописать на это дело кнопу.
И еще маленький нюанс (но очень существенный),
прога вставляет гиперссылки всегда начиная с первой (верхней левой) ячейки. Нельзя ли сделать так, чтобы она вставляла гиперссылки начиная с текущей ячейки (выделенной).
С трудом, но я все таки запустил этот макрос, вот только что такое Personal.xls - у меня такого файла нет, и можно ли сделать чтобы он был доступен в excel всегда,и прописать на это дело кнопу.
И еще маленький нюанс (но очень существенный),
прога вставляет гиперссылки всегда начиная с первой (верхней левой) ячейки. Нельзя ли сделать так, чтобы она вставляла гиперссылки начиная с текущей ячейки (выделенной).
Цитата:
Originally posted by Апельсинов
:) Здорово!!! Большое спасибо!!!
С трудом, но я все таки запустил этот макрос, вот только что такое Personal.xls - у меня такого файла нет, и можно ли сделать чтобы он был доступен в excel всегда,и прописать на это дело кнопу.
И еще маленький нюанс (но очень существенный),
прога вставляет гиперссылки всегда начиная с первой (верхней левой) ячейки. Нельзя ли сделать так, чтобы она вставляла гиперссылки начиная с текущей ячейки (выделенной).
:) Здорово!!! Большое спасибо!!!
С трудом, но я все таки запустил этот макрос, вот только что такое Personal.xls - у меня такого файла нет, и можно ли сделать чтобы он был доступен в excel всегда,и прописать на это дело кнопу.
И еще маленький нюанс (но очень существенный),
прога вставляет гиперссылки всегда начиная с первой (верхней левой) ячейки. Нельзя ли сделать так, чтобы она вставляла гиперссылки начиная с текущей ячейки (выделенной).
Да, конечно можно.
ближе к концу найди строчки:
iRow = 1 ' начинаем с 1 строки (можно менять, :-) )
iCol = 1 ' пишем в 1 столбец (можно менять, :-) )
и единицы замени соответственно вот так:
iRow = Selection.Row ' начинаем с 1 строки (можно менять, :-) )
iCol = Selection.Column ' пишем в 1 столбец (можно менять, :-) )
Теперь по поводу того, чтобы макрос был всегда.
Есть в Excel'e личная книга макросов (всегда есть). Это файл, который называется Personal.xls и лежит в папке C:\Windows\Application Data\Microsoft\Excel\XLSTART - (если файл лежит в этой папке, то он автоматически стартует вместе с Excel).
Так вот про этот Personal.xls, лежит он значит себе в этой папочке и автоматически
стартует вместе с Excel, но его после запуска не видно, потому как статус у него стоит - скрытый. Если ты посмотришь в меню: "Окно", там будет пункт меню - "Скрыть" (так можно любую книгу скрыть) и "Отобразить" (соотв. наборот), нажимаешь и выводится список всех скрытых загруженных книг - отображать тебе книгу Personal.xls не надо, мы до него по другому доберемся, а это так, для общего развития.
Так вот, этот Personal.xls по сути совершенно обычный файл (книга Excel'a), у него тоже есть листы и модули, куда можно записать макросы, а так как файл грузится всегда, то эти макросы будут тоже доступны всегда (если потом, когда-нибудь, сменишь компьютер, то просто перенеси файл Personal.xls на новый компьютер и скопируй его в такую же папку и все макросы опять будут с тобой).
Теперь как добавить туда наш макрос:
1. В Ecxel'e нажми Alt+F11
2. Попал в редактор Visual Basic, нажми Ctrl+R? что показать окошко - "Project VBAProject" (обычно оно по умолч. открыто, но если не было, он откроется)
3. Находим в этом окне строку - VBAProject(PERSONAL.XLS)
4. Щелкаем на плюсик, открывается древо, находим папочку - Modules
5. Щелкаем правой кнопкой мыши и в контексном меню выбираем пункт - Insert, а потом Module.
6. Появился новый пустой модуль.
7. В появившееся окно вставляем наш код
8. Нажимаем слева вверху на дискету, чтобы сохранить и закрываем окно Microsoft Visual Basic полностью, оно нам больше не понадобится, возвращаемся в Excel.
Теперь чтобы привязать кнопку к нашему макросу.
1. Правой кнопкой мыши щелкаем по панели с кнопками и выбираем последний пункт меню - Настройка.
2.Выбираем вкладку - Команды.
3. На ней два списочка: Категория и Команды.
4. В Категории выбираем строку - Макросы.
5. Справо появилось 2 пунктика, выбираем пункт - Настраиваемая кнопка (с такой радостной рожей)
6. Нажимаем на этот пункт левой клавишой мыши и НЕ ОТПУСКАЯ тянем на панель Excel'a, туда куда хотим.
7. Отпускаем левую клавишу мыши - кнопка приземляется в том месте где мы ее бросили.
8. Теперь щелакаем правой клавишой мыши по этой кнопке(не закрывая при этом окна - Настройка) и видим мюню, в котором можно поменять рисунок кнопки, оставить только текст или только рисунок без подписи и т.д. нас интересует щас последний пункт - Назначить макрос...
9. Выбираем этот пункт и в появившемся окошке, среди доступных всех макросов ищем такую строку - PERSONAL.XLS!AddHyperlinksToFile (именно так, а то еще может быть просто AddHyperlinksToFile, это макрос из активной книги, который потом пропадет как только ты закроешь файл с ним связанный).
Вот вроде бы и все! :-)
все получилось, все работает.
Слава людям с мозгами!
И отдельное огромное спасибо SergeySV!!!!
Слава людям с мозгами!
И отдельное огромное спасибо SergeySV!!!!
Круто, рад что у тебя все получилось с первого раз, думал что еще придется немного поползать в VBA-редакторе (обычно его боятся люди далекие от программирования, и попав туда, путаются) :-) у тебя все ОК.
Господа, а какой функцией, применительно к этому коду, можно обрезать имена файлов, отображаемых в ячейках гиперссылками до скольки-то(к примеру 9) знаков? Очень надо...
Например так :
Код:
TextToDisplay:=Left(fileList(i), 9)
P.S. Обладатели Microsoft Excel XP (или старше), для выбора папки и создания гиперссылок в первом столбце активного рабочего листа, могут воспользоваться следующим макросом :
Код:
Private Sub CreateHyperlinksToFiles() 'Microsoft Excel XP (и старше)
Dim iPath$, iFileName$, iRow&
Dim iFolderDialog As FileDialog, iCell As Range
Set iFolderDialog = Application.FileDialog(msoFileDialogFolderPicker)
If iFolderDialog.Show = -1 Then
Application.ScreenUpdating = False
iPath = iFolderDialog.SelectedItems(1) & "\"
iFileName = Dir(iPath): Columns(1).Clear
Do Until iFileName = ""
iRow = iRow + 1: Set iCell = Cells(iRow, 1)
iCell.Hyperlinks.Add iCell, iPath & iFileName, , , iFileName
iFileName = Dir
Loop
Application.ScreenUpdating = True
Else
MsgBox "Нужно было выбрать папку ...", vbCritical, ""
End If
End Sub
Dim iPath$, iFileName$, iRow&
Dim iFolderDialog As FileDialog, iCell As Range
Set iFolderDialog = Application.FileDialog(msoFileDialogFolderPicker)
If iFolderDialog.Show = -1 Then
Application.ScreenUpdating = False
iPath = iFolderDialog.SelectedItems(1) & "\"
iFileName = Dir(iPath): Columns(1).Clear
Do Until iFileName = ""
iRow = iRow + 1: Set iCell = Cells(iRow, 1)
iCell.Hyperlinks.Add iCell, iPath & iFileName, , , iFileName
iFileName = Dir
Loop
Application.ScreenUpdating = True
Else
MsgBox "Нужно было выбрать папку ...", vbCritical, ""
End If
End Sub
ок, спасибо. а еще такой вопрос: мне принципиальна сортировка массива. каким образом задать строгое соответствие сортировки как в исходной директории???
Если важен порядок расположения файлов, то давайте просто откроем нужную папку и доберёмся до её элементов. А если нужны также и папки, то просто удалите/закомментируйте соответствующую проверку
Код:
'Диалог выбора папки - http://forum.codenet.ru/q18850
Private Sub CreateHyperlinksToFiles2() 'Microsoft Excel 97 (и старше)
Dim iShell As Object, iWin As Object
Dim iFolder As Object, iFolderItem As Object
Dim iList As Worksheet, iPath$, iCount&, iRow&
Set iShell = CreateObject("Shell.Application")
Set iWin = iShell.Windows: iCount = iWin.Count + 1
Set iFolder = iShell.BrowseForFolder(&H0, " Выберите папку....", &H1, 17)
If Not iFolder Is Nothing Then
iPath = iFolder.Items.Item.Path 'универсальный вариант для WIN9х/NT
'iPath = iPath.Self.Path 'вариант для WINNT
Shell "Explorer.exe " & iPath, vbHide 'vbMinimizedNoFocus
Set iList = ActiveSheet: iList.Columns(1).Clear
'Можно указать любой другой лист, ячейки которого не защищены
Do Until iWin.Count = iCount
DoEvents
Loop
Set iWin = iWin(iCount - 1)
Set iFolder = iWin.Document.Folder
For Each iFolderItem In iFolder.Items
If Not iFolderItem.IsFolder Then
iRow = iRow + 1
iList.Hyperlinks.Add iList.Cells(iRow, 1), _
iFolderItem.Path, , , "'" & iFolderItem.Name
End If
Next
iWin.Quit
End If
End Sub
Private Sub CreateHyperlinksToFiles2() 'Microsoft Excel 97 (и старше)
Dim iShell As Object, iWin As Object
Dim iFolder As Object, iFolderItem As Object
Dim iList As Worksheet, iPath$, iCount&, iRow&
Set iShell = CreateObject("Shell.Application")
Set iWin = iShell.Windows: iCount = iWin.Count + 1
Set iFolder = iShell.BrowseForFolder(&H0, " Выберите папку....", &H1, 17)
If Not iFolder Is Nothing Then
iPath = iFolder.Items.Item.Path 'универсальный вариант для WIN9х/NT
'iPath = iPath.Self.Path 'вариант для WINNT
Shell "Explorer.exe " & iPath, vbHide 'vbMinimizedNoFocus
Set iList = ActiveSheet: iList.Columns(1).Clear
'Можно указать любой другой лист, ячейки которого не защищены
Do Until iWin.Count = iCount
DoEvents
Loop
Set iWin = iWin(iCount - 1)
Set iFolder = iWin.Document.Folder
For Each iFolderItem In iFolder.Items
If Not iFolderItem.IsFolder Then
iRow = iRow + 1
iList.Hyperlinks.Add iList.Cells(iRow, 1), _
iFolderItem.Path, , , "'" & iFolderItem.Name
End If
Next
iWin.Quit
End If
End Sub
спасибо огромное красивый и компактный код.
Дополнение : если при выполнении вышеопубликованного макроса, пользователь выберет уже открытую папку, то вряд ли получит список желаемых гиперссылок :( Бороться с таким безобразием можно немного изменив вызов VB(A) функции Shell, а именно - явно указав, что папку нужно открывать в новом окне (см.далее)
Все же остальные изменения не носят обязательного характера.
P.S. Если элементов папки = гиперссылок может быть довольно много, то при заполнении ячеек - имеет смысл отключить обновление экрана, т.е. Application.ScreenUpdating = False / True
Все же остальные изменения не носят обязательного характера.
Код:
'Диалог выбора папки - http://forum.codenet.ru/q18850
Private Sub CreateHyperlinksToFiles3() 'Microsoft Excel 2000 (и старше)
Dim iList As Worksheet, iRow&
Dim iShell As Object, iWin As Object
Dim iFolder As Object, iFolderItem As Object
Set iShell = CreateObject("Shell.Application")
Set iFolder = iShell.BrowseForFolder(&H0, " Выберите папку....", &H1, 17)
If Not iFolder Is Nothing Then
Shell "Explorer.exe /e, " & iFolder.Self.Path, vbHide
Set iWin = iShell.Windows(iShell.Windows.Count - 1)
Do While iWin Is Nothing 'Do Until Not iWin Is Nothing
DoEvents
Loop
Set iList = ActiveSheet: iList.Columns(1).Clear
For Each iFolderItem In iWin.Document.Folder.Items
iRow = iRow + 1
iList.Hyperlinks.Add iList.Cells(iRow, 1), _
iFolderItem.Path, , , "'" & iFolderItem.Name
Next
iWin.Quit
End If
End Sub
Private Sub CreateHyperlinksToFiles3() 'Microsoft Excel 2000 (и старше)
Dim iList As Worksheet, iRow&
Dim iShell As Object, iWin As Object
Dim iFolder As Object, iFolderItem As Object
Set iShell = CreateObject("Shell.Application")
Set iFolder = iShell.BrowseForFolder(&H0, " Выберите папку....", &H1, 17)
If Not iFolder Is Nothing Then
Shell "Explorer.exe /e, " & iFolder.Self.Path, vbHide
Set iWin = iShell.Windows(iShell.Windows.Count - 1)
Do While iWin Is Nothing 'Do Until Not iWin Is Nothing
DoEvents
Loop
Set iList = ActiveSheet: iList.Columns(1).Clear
For Each iFolderItem In iWin.Document.Folder.Items
iRow = iRow + 1
iList.Hyperlinks.Add iList.Cells(iRow, 1), _
iFolderItem.Path, , , "'" & iFolderItem.Name
Next
iWin.Quit
End If
End Sub