ドライブ全体をファイル検索する
 以下のマクロは、入力されたドライブ全体から全てのExcelファイルを
検索するマクロです。また、見つかったファイルのパスを含むファイル名
とファイルサイズ及び、更新日付をシート上に貼り付けます。

Sub File_Search()

    Dim i       As Long
    Dim myFound As String
    Dim sDrv    As String
    
    ' 画面更新をとめます
    Application.ScreenUpdating = False
    ' 検索対象となるドライブ名を入力させます
    sDrv = StrConv(InputBox("ドライブ名を入力してください", _
                                "ドライブ名設定", "C"), vbNarrow) & ":\"
    
    DefaultSheetNum% = Application.SheetsInNewWorkbook
    ' タイトル行を作成します
    ActiveSheet.Cells(1, 1).Value = "File_Name"
    ActiveSheet.Cells(1, 2).Value = "Size"
    ActiveSheet.Cells(1, 3).Value = "Date"
     
    ' ファイル検索を開始します
    With Application.FileSearch
        .NewSearch
        .LookIn = sDrv
        .SearchSubFolders = True
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Cells(i + 1, 1).Value = .FoundFiles(i)
                Cells(i + 1, 2).Value = FileLen(.FoundFiles(i))
                Cells(i + 1, 3).Value = FileDateTime(.FoundFiles(i))
            Next i
            ActiveSheet.Columns("A:C").AutoFit
            MsgBox .FoundFiles.Count & " 個のファイルが見つかりました。"
        Else
            MsgBox "対象ファイルはありませんでした"
        End If
    End With
    
    ' 画面更新を再開します
    Application.ScreenUpdating = True
    
End Sub

Excel97/2000



戻る


Excel Word Access VBA! モーグ