|
DOSコマンドのDIRで、My Documentsフォルダー内のサブフォルダーを
一気にシートへ書き出し、数式を使って該当するものを判定、抽出処理
します。C:\My Documents というのは Win98以前のパスなので、
DOSプロンプトを出す "COMMAND.COM" にしておきましたが、Win2000/XP
ならコマンドプロンプトの "CMD.EXE" にして下さい。(定数 CmdSt の値)
Sub SEARCH_DIR()
Dim WshShell As Object, oExec As Object
Dim i As Long
Dim MyDoc As String, MyRet As String
Const CmdSt As String = "COMMAND.COM /C DIR /A:D /B /S "
'↑Win2000/XPの場合は COMMAND.COM → CMD.EXE に変更する
Set WshShell = CreateObject("WScript.Shell")
MyDoc = WshShell.SpecialFolders("MyDocuments") & "\*"
Application.ScreenUpdating = False
Set oExec = WshShell.Exec(CmdSt & """" & MyDoc & """")
Do Until oExec.StdOut.AtEndOfStream
MyRet = oExec.StdOut.ReadLine: i = i + 1
Cells(i, 1).Value = MyRet
Loop
Set oExec = Nothing: Set WshShell = Nothing
With Range("A1", Range("A65536").End(xlUp)).Offset(, 255)
.Formula = "=IF(OR(ISERR(FIND(""表"",$A1))," & _
"ISERR(FIND(""単価"",$A1)),ISERR(FIND(""株"",$A1))),1)"
.SpecialCells(3, 1).EntireRow.Delete xlShiftUp
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
|
|