-
질문 & 답변
카테고리
-
세부 분야
오피스
-
해결 여부
미해결
하이퍼링크관련 vba 질문드립니다
20.11.29 09:01 작성 조회수 172
1
엑셀파일 목록에 있는 만개정도의 파일을 추출하여 하나의 폴더에 저장하였습니다.
그런데 엑셀에 있는 파일목록과 폴더내의 추출한 파일을 하이퍼링크로 연결하고자 합니다.
혹시 이와 관련된 vba 코드를 알수 있을까요?
업무와 관련된건데 아무리 구글링을 해도 찾을 수 없어 질문드립니다~^^;
답변을 작성해보세요.
0
엑셀여신
지식공유자2020.11.30
네~ 안녕하세요?
파일을 올려드리면 좋은데, 이곳에는 파일이 업로드가 안되네요~
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
답변 1