2013. 12. 23. 10:56

파일 리스트 조회하기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.


Sub getFolder()

       

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45

        

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30

    

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    Range("c3").Select

    Selection.ClearContents

    

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

        

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"




    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    

    

    ' 현재 있는 데이터를 모두 삭제해야 함.

    Sheets("fileSheet").Activate

    ActiveSheet.Range("c3").Value = ""

    ActiveSheet.Range("b9:f10000").Value = ""

    ActiveSheet.Cells(8, 6).Value = 9

    

    '서브폴더의 내용을 가져옴

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

        .Title = "검색할 폴더를 선택 하세요"

        If .Show = -1 Then

            Range("c3") = .SelectedItems(1) '선택한 폴더명을 A3 셀에 저장

            folderspec = Range("c3").Value

        

        End If

    End With

    

End Sub


Sub getSubFolderInHere()

        

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45


        

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30


    

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    

    

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

        

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"



    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    

    strDir = Range("c3").Value

    strFileType = Range("c4").Value

    ActiveSheet.Range("b9:f10000").Value = ""

    

    If strDir = "" Then

        getFolder

        Exit Sub

    ElseIf strFileType = "" Then

        strFileType = "*"

    End If

        

    r = 9

    

    

    Sheets(1).Cells(7, 1) = "검색폴더"

    Sheets(1).Cells(7, 2) = strDir

    Sheets(1).Cells(8, 1) = "검색단어"

    Sheets(1).Cells(8, 2) = strFileType

    Sheets(1).Cells(r, 1) = "번호"

    Sheets(1).Cells(r, 2) = "하위 폴더명"

    Sheets(1).Cells(r, 2).ColumnWidth = 45

    Sheets(1).Cells(r, 3) = "파일명"

    Sheets(1).Cells(r, 3).ColumnWidth = 45

    Sheets(1).Cells(r, 4) = "크기"

    Sheets(1).Cells(r, 5) = "파일타입"

    Sheets(1).Cells(r, 6) = "작성일"

    Sheets(1).Cells(r, 7) = "수정일"

    

    Sheets(1).Range(Cells(r, 1), Cells(r, 6)).Select

    Selection.AutoFilter

    

    Cells(10, 2).Select

    ActiveWindow.FreezePanes = True

        

    Sheets(1).Range("a10", "g1000").Select

    Selection.ClearContents

    

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    

    strFilter = "*" & Sheets(1).Range("c4").Value & "*"

    

    result = sRetrieveInHere(strDir, strFilter, r)

    

    Sheets(1).Range("a1:g1000").Font.Name = "Arial"

    Sheets(1).Range("a1:g1000").Font.Size = 9

    Sheets(1).Range(Cells(4, 2), Cells(r, 2)).Select

    

    Selection.Replace What:=Cells(1, 2), Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

     

    Selection.Font.Underline = xlUnderlineStyleNone

    

    Sheets(1).Cells(4, 2).Select

End Sub



Sub getSubFolderInNext()

        

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45


        

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30

    

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    

    

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

        

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"



    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    

    strDir = Range("c3").Value

    strFileType = Range("c4").Value

    ActiveSheet.Range("b9:f10000").Value = ""

    

    If strDir = "" Then

        getFolder

        Exit Sub

    ElseIf strFileType = "" Then

        strFileType = "*"

    End If

        

    r = 3

    

    Sheets.Add after:=Sheets(1)

    Sheets(2).Name = Date & Hour(Time) & Minute(Time) & Second(Time)

    

    

    Sheets(2).Cells(7, 1) = "검색폴더"

    Sheets(2).Cells(7, 2) = strDir

    Sheets(2).Cells(8, 1) = "검색단어"

    Sheets(2).Cells(8, 2) = strFileType

    Sheets(2).Cells(r, 1) = "번호"

    Sheets(2).Cells(r, 2) = "하위 폴더명"

    Sheets(2).Cells(r, 2).ColumnWidth = 45

    Sheets(2).Cells(r, 3) = "파일명"

    Sheets(2).Cells(r, 3).ColumnWidth = 45

    Sheets(2).Cells(r, 4) = "크기"

    Sheets(2).Cells(r, 5) = "파일타입"

    Sheets(2).Cells(r, 6) = "작성일"

    Sheets(2).Cells(r, 7) = "수정일"

    

    Sheets(2).Range(Cells(r, 1), Cells(r, 6)).Select

    Selection.AutoFilter

    

    Cells(4, 2).Select

    ActiveWindow.FreezePanes = True

        

    Sheets(2).Range("a4", "g1000").Select

    Selection.ClearContents

    

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    

    strFilter = "*" & Sheets(1).Range("c4").Value & "*"

    

    result = sRetrieveInNext(strDir, strFilter, r)

    

    Sheets(2).Range("a1:g1000").Font.Name = "Arial"

    Sheets(2).Range("a1:g1000").Font.Size = 9

    Sheets(2).Range(Cells(4, 2), Cells(r, 2)).Select

    

    Selection.Replace What:=Cells(1, 2), Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

     

    Sheets(2).Cells(4, 2).Select

End Sub



Private Function sRetrieveInNext(sPath As String, strFilter As String, r As Long) As String

    

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    

    For Each dDir In dDirs.SubFolders

        sRetrieveInNext = sRetrieveInNext(dDir.Path, strFilter, r)

    Next

    

    For Each fFile In dDirs.Files

        If fFile.Name Like "~*" Then

        ElseIf fFile.Name Like strFilter Then

            

            Sheets(2).Cells(r, 1) = r - 3

            Sheets(2).Cells(r, 2) = fFile.parentfolder.Path


            anchorinfo = fFile.parentfolder.Path + "\" + fFile.Name

             

            ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 3), Address:=anchorinfo, TextToDisplay:=fFile.Name

            Sheets(2).Cells(r, 4) = fFile.Size

            Sheets(2).Cells(r, 5) = fFile.Type

            Sheets(2).Cells(r, 6) = Left(fFile.datecreated, 10)

            Sheets(2).Cells(r, 7) = Left(fFile.DateLastModified, 10)

            

                     

           r = r + 1

        End If

    Next

    

    Set fs = Nothing

    

End Function


 


Private Function sRetrieveInHere(sPath As String, strFilter As String, r As Long) As String

    

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    

    For Each dDir In dDirs.SubFolders

        sRetrieveInHere = sRetrieveInHere(dDir.Path, strFilter, r)

    Next

    

    For Each fFile In dDirs.Files

        

        If fFile.Name Like "~*" Then

        ElseIf fFile.Name Like strFilter Then

            

            Sheets(1).Cells(r, 1) = r - 9

            Sheets(1).Cells(r, 2) = fFile.parentfolder.Path


            anchorinfo = fFile.parentfolder.Path + "\" + fFile.Name

             

            ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 3), Address:=anchorinfo, TextToDisplay:=fFile.Name

            

            Sheets(1).Cells(r, 4) = fFile.Size

            Sheets(1).Cells(r, 5) = fFile.Type

            Sheets(1).Cells(r, 6) = Left(fFile.datecreated, 10)

            Sheets(1).Cells(r, 7) = Left(fFile.DateLastModified, 10)

            

                     

           r = r + 1

        End If

    Next

    

    Set fs = Nothing

    

End Function