하이퍼링크관련 vba 질문드립니다

Question

엑셀파일 목록에 있는 만개정도의 파일을 추출하여 하나의 폴더에 저장하였습니다. 그런데 엑셀에 있는 파일목록과 폴더내의 추출한 파일을 하이퍼링크로 연결하고자 합니다. 혹시 이와 관련된 vba 코드를 알수 있을까요? 업무와 관련된건데 아무리 구글링을 해도 찾을 수 없어 질문드립니다~^^;

엑셀여신 · Answer

네~ 안녕하세요? 파일을 올려드리면 좋은데, 이곳에는 파일이 업로드가 안되네요~ sub 프로시저 1개와 사용자정의함수 1개로 2개가 사용되었습니다. 모두 복사해서 실행해보세요~^^ 파일 개수 100개정도만 테스트 했는데, 10,000개 테스트는 못했는데 속도가 어떨지 모르겠습니다. ------------------ Sub 파일링크목록만들기() Dim strPath As String, strFile As String Dim rngWork As Range, wkB As Workbook Dim R As Long strPath = 폴더정보함수("작업 폴더 선택", , msoFileDialogViewSmallIcons) If strPath = "" Then Exit Sub If Right(strPath, 1) <> "\" Then strPath = strPath & "\" strFile = Dir(strPath, vbDirectory) If strFile = "" Then MsgBox "존재하지 않는 경로명입니다.", , "경로명 오류" Exit Sub End If Set wkB = ThisWorkbook Set rngWork = wkB.Sheets(1).Range("A1") With rngWork .Offset(R, 0) = "선택폴더 : " .Offset(R, 1) = strPath R = R + 2 .Offset(R, 0) = "파일목록" Do While strFile <> "" If strFile <> "." And strFile <> ".." Then R = R + 1 .Offset(R, 0) = strFile .Offset(R, 0).Hyperlinks.Add Anchor:=.Offset(R, 0), Address:=strPath & strFile, TextToDisplay:=.Offset(R, 0).Value End If strFile = Dir Loop End With Err_Rtn: If Err.Number <> 0 Then MsgBox "파일 목록 작성중 다음 오류가 발생했습니다." _ & vbCr & Err.Description, vbCritical, "오류발생" Else MsgBox "작업이 완료되었습니다.", vbInformation, "완료" End If End Sub Function 폴더정보함수(Title As String, Optional InitialFolder As String = "", _ Optional InitialView As Office.MsoFileDialogView = msoFileDialogViewList) As String Dim V As Variant Dim InitFolder As String With Application.FileDialog(msoFileDialogFolderPicker) .Title = Title .InitialView = InitialView If Len(InitialFolder) > 0 Then If Dir(InitialFolder, vbDirectory) <> "" Then InitFolder = InitialFolder If Right(InitFolder, 1) <> "\" Then InitFolder = InitFolder & "\" .InitialFileName = InitFolder End If End If .Show If .SelectedItems.Count > 0 Then 폴더정보함수 = .SelectedItems(1) Else 폴더정보함수 = "" End If End With End Function