인프런 커뮤니티 질문&답변

네~ 안녕하세요?

파일을 올려드리면 좋은데, 이곳에는 파일이 업로드가 안되네요~

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