filesearch 대용

인터넷을 뒤져보니 화일을 열거하는 예제는 많지만 내맘에 쏙드는 게 없다....

또한 FileSearch가 엑셀2007부터는 동작이 잘 안된다고 한다.

할수 없이 FileSystemObject를 이용해서 만들었다.

 

Option Explicit

'폴더선택창을 만드는 구문을 베껴적음
Public Type BROWSfromFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
  "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowsfromfo As BROWSfromFO) As Long
Dim Fs As Object
Dim lngRow As Long

 

Private Function GetDirectory(Optional Msg As String) As String
Dim bInfo As BROWSfromFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
    bInfo.pidlRoot = 0&
    If IsMissing(Msg) Then
      bInfo.lpszTitle = "Please select from Formatting."
    Else
      bInfo.lpszTitle = Msg
    End If
    bInfo.ulFlags = &H1
    x = SHBrowseForFolder(bInfo)
    Path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal Path)
    If r Then
      pos = InStr(Path, Chr$(0))
      GetDirectory = Left(Path, pos - 1)
    Else
      GetDirectory = ""
    End If
End Function

 

Sub FolderFiles()
Dim objFolder As Object
Dim objFile As Object
Dim strDir As String
    strDir = GetDirectory
    If strDir = "" Then Exit Sub
   
    Set Fs = CreateObject("Scripting.FileSystemObject")
    Set objFolder = Fs.GetFolder(strDir)
   
    Cells.ClearContents
    Cells(1, 1) = "<dir>" & objFolder.Name & " (" & _
      Format(objFolder.Size, "#,##0,") & "kb)"
    lngRow = 2
    For Each objFile In objFolder.Files
      Cells(lngRow, 2) = objFile.Name & " (" & Format(objFile.Size, "#,##0,") & "kb)"
      ActiveSheet.Hyperlinks.Add anchor:=Cells(lngRow, 2), Address:= _
        strDir & "/" & objFile.Name
      lngRow = lngRow + 1
    Next objFile
    Call FindSubfolder(objFolder, 2)
End Sub

 

Sub FindSubfolder(ByVal Path As String, lngCol As Long)
Dim objFolder As Object, subFolder As Object
Dim objFile As Object
    Set objFolder = Fs.GetFolder(Path)
   
    For Each subFolder In objFolder.SubFolders
        Cells(lngRow, lngCol) = "<dir>" & subFolder.Name & " (" & _
          Format(subFolder.Size, "#,##0,") & "kb)"
        lngRow = lngRow + 1
        For Each objFile In subFolder.Files
          Cells(lngRow, lngCol + 1) = objFile.Name & " (" & Format(objFile.Size, "#,##0,") & "kb)"
          ActiveSheet.Hyperlinks.Add anchor:=Cells(lngRow, lngCol + 1), Address:= _
            subFolder.Path & "/" & objFile.Name
          lngRow = lngRow + 1
        Next objFile
        
        '재귀용법
        Call FindSubfolder(subFolder, lngCol + 1)
    Next
End Sub

[출처] (엑셀vba)FileSystemObject를 이용하여 폴더 및 화일을 열거하기...|작성자 앳마