Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6130 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【46716】フォルダ検索 みな 07/2/13(火) 10:23 質問[未読]
【46717】Re:フォルダ検索 neptune 07/2/13(火) 10:55 回答[未読]
【46734】Re:フォルダ検索 みな 07/2/13(火) 14:37 お礼[未読]
【46732】Re:フォルダ検索 Kein 07/2/13(火) 14:17 回答[未読]
【46733】Re:フォルダ検索 みな 07/2/13(火) 14:33 質問[未読]
【46735】Re:フォルダ検索 Kein 07/2/13(火) 14:51 回答[未読]
【46741】Re:フォルダ検索 みな 07/2/13(火) 17:01 お礼[未読]
【47040】Re:フォルダ検索(再び） みな 07/2/26(月) 17:08 質問[未読]
【47041】Re:フォルダ検索(再び） Kein 07/2/26(月) 18:12 回答[未読]
【47051】Re:フォルダ検索(再び） みな 07/2/27(火) 9:40 質問[未読]
【47052】Re:フォルダ検索(再び） みな 07/2/27(火) 9:52 お礼[未読]
【46716】フォルダ検索
質問  みな  - 07/2/13(火) 10:23 -
引用なし
パスワード
   　お世話になります。vba初心者で、申し訳ありません。
フォルダの検索をするプログラムを作りたいと思っています。
フォルダ名に【表,単価,株】を全て含むフォルダの一覧を
表示したいのですが、フォルダ名のどこに【表,単価,株】が含まれて
いるのかがわからない状態なので、検索の仕方がわかりません。
ご教授願えないでしょうか？

例（下記のようなフォルダが表示されたい）
C:\My Documents\aaa\bbb\c株式会社\各単価\一覧表\
C:\My Documents\単価表\株式一覧\
C:\My Documents\bbb\(株)abc商事\検査表\単価\
【46717】Re:フォルダ検索
回答  neptune  - 07/2/13(火) 10:55 -
引用なし
パスワード
   こんにちは

>検索の仕方がわかりません。
下記のサンプルプログラムをじっくり研究してみて下さい。
h　t　tp://homepage2.nifty.com/sak/w_sak3/doc/sysbrd/vb_t22.htm
↑ここは修正してください。この掲示板はリンクできませんので。
【46732】Re:フォルダ検索
回答  Kein  - 07/2/13(火) 14:17 -
引用なし
パスワード
   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
【46733】Re:フォルダ検索
質問  みな  - 07/2/13(火) 14:33 -
引用なし
パスワード
   ▼Kein さん：
回答ありがとうございました。
ウマくできました。
あと、もう一つだけ質問させてください。


同じ条件で『D:\顧客』というフォルダの中を検索する時は、

>　 Const CmdSt As String = "COMMAND.COM /C DIR /A:D /B /S "
　→Const CmdSt As String = "COMMAND.COM /R DIR /A:D /B /S "
>　 MyDoc = WshShell.SpecialFolders("MyDocuments") & "\*"
　→MyDoc = WshShell.SpecialFolders("顧客") & "\*"

と変更するだけで可能なのでしょうか？
【46734】Re:フォルダ検索
お礼  みな  - 07/2/13(火) 14:37 -
引用なし
パスワード
   ▼neptune さん：
回答ありがとうございました。
早速確認して、勉強しております。
ご教授いただき本当に感謝してます。ありがとうございました。
【46735】Re:フォルダ検索
回答  Kein  - 07/2/13(火) 14:51 -
引用なし
パスワード
   SpecialFoldersプロパティの引数に指定できる値は、DeskTop とか
MyDocuments とか System など、決められたものに限定されます。
それ以外の一般的なパスにしたいなら、直接その文字列を定数に含めて
しまえば良いでしょう。つまり変数 MyDoc は不要になるので・・

Sub SEARCH_DIR()
　 Dim WshShell As Object, oExec As Object
　 Dim i As Long
　 Dim MyRet As String
　 Const CmdSt As String = _
　 "COMMAND.COM /C DIR /A:D /B /S D:\顧客\*"
　　　
　 Set WshShell = CreateObject("WScript.Shell")
　 Application.ScreenUpdating = False
　 Set oExec = WshShell.Exec(CmdSt)
　 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

というようにしてみて下さい。
【46741】Re:フォルダ検索
お礼  みな  - 07/2/13(火) 17:01 -
引用なし
パスワード
   ▼Kein さん：
たびたびの回答ありがとうございました。
ウマく出来ました。
お手数かけて申し訳ありませんでした。
本当にありがとうございました。
【47040】Re:フォルダ検索(再び）
質問  みな  - 07/2/26(月) 17:08 -
引用なし
パスワード
   以前、フォルダの一覧を作成する質問をさせて頂き、dosコマンドで
フォルダを書き出す方法を教えてもらいました。
そこで、少しやり方（セルに指定されたパス内を検索する）を変えて、
プログラムを変更しました。
が、セル値をcドライブにするとうまく動きません。どこが間違っているのか
教えていただきたく、もう一度質問させていただきました。
よろしくお願いします。

☆下記プログラムにて、
　Range("a1")の値が『d:\顧客』の時はうまく実行されますが、
　『C:\My Documents\顧客』だとdosコマンドがうまく動きません。


Sub SEARCH_DIR()
　 Dim WshShell As Object, oExec As Object
　 Dim i As Long
　 Dim MyDoc As String, MyRet As String
　 MyDoc = Trim(Range("a1").Value) & "\*"
　 Dim CmdSt As String
　 CmdSt = "Cmd.exe /C DIR /A:D /B /S " & MyDoc
　
　 Set WshShell = CreateObject("WScript.Shell")
　 Application.ScreenUpdating = False
　 Set oExec = WshShell.Exec(CmdSt)
　 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
【47041】Re:フォルダ検索(再び）
回答  Kein  - 07/2/26(月) 18:12 -
引用なし
パスワード
   パスに半角スペースが含まれる場合、そこで区切られてコマンドの引数の一つ
とみなされてしまいます。それを正しくパスとして認識させるためには、"" で
囲むか「8.3 形式のファイル名」に変換する必要があります。ま、"" 囲む方が
簡単なので、以下のように修正してみて下さい。それでうまくいかない場合は、
後者のコードをお教えします。

Sub SEARCH_DIR()
　 Dim WshShell As Object, oExec As Object
　 Dim i As Long
　 Dim MyDoc As String, CmdSt As String, Ret As String

　 MyDoc = Trim(Range("A1").Value)
　 If Dir(MyDoc, 16) = "" Then
　　　MsgBox "そのフォルダーは見つかりません", 48: Exit Sub
　 End If
　 CmdSt = "Cmd.exe /C DIR /A:D /B /S " & """" & MyDoc & "\*"""""
　 Set WshShell = CreateObject("WScript.Shell")
　 Application.ScreenUpdating = False
　 Set oExec = WshShell.Exec(CmdSt)
　 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
【47051】Re:フォルダ検索(再び）
質問  みな  - 07/2/27(火) 9:40 -
引用なし
パスワード
   Kein さん
いつもご回答いただきありがとうございます。
早速、ご教授いただいたプログラムを実行してみたのですが、
同じく、Range("a1")の値が『C:\My Documents\顧客』だとdosコマンドがうまく動きません。また『d:\顧客』にすると【そのフォルダーは見つかりません】と表示されます。
バージョンなど関係するのでしょうか？
【47052】Re:フォルダ検索(再び）
お礼  みな  - 07/2/27(火) 9:52 -
引用なし
パスワード
   Kein さん
ごめんなさい。私の勘違いでした。
ご教授いただいたプログラムでうまく行きました。
本当にすみません。
つたない文章にも関わらず、いつもご教授いただき本当に感謝しています。

これからも、皆さんに甘えるのではなく、できればここに質問しないですむよう
努力はしていきますが、また行き詰ったときは、ご教授いただければ嬉しいです。
回答くださった皆様には本当に感謝しております。ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6130 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free