部分検索でフォルダ名を検索するマクロ

このQ&Aのポイント
  • Excel2013、windows8を利用しています。任意の文字を入力して、その文字を含むサブフォルダを検索するマクロを考えています。
  • マクロは指定されたフォルダ内のサブフォルダを順に検索し、指定された文字を含むフォルダ名のみを出力します。
  • 上記のマクロは正しく動作しないようですが、具体的なエラーや出力がないため、原因を特定するのが難しいです。
回答を見る
  • ベストアンサー

部分検索でフォルダ名を検索するマクロ

Excel2013、windows8を利用しています。 任意の文字を入力して、その文字を含むサブフォルダを検索するマクロを考えています。 以下の例ではフォルダパス\\000.00.000.00\ab\c\内のサブフォルダから、ワタナベという文字 を含むサブフォルダ名のみを検索し、サブフォルダ名をvbaのイミディエイトに結果を出力するマクロを作ったつもりなのですが正しく動きません(エラーが出るわけでは無いのですが何も出力されない)。 どこが間違っているのか教えて頂けないでしょうか? 以下のマクロをつくるにあたって参考にしたホームページは http://officetanaka.net/excel/vba/tips/tips36.htm です Sub Sample() Call FileSearch("\\000.00.000.00\ab\c\", "ワタナベ") End Sub Sub FileSearch(Path As String, Target As String) Dim FSO As Object, Folder As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders If Folder.Name Like Target Then Debug.Print Folder.Path End If Next Folder End Sub

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

Like Target Then を Like "*" & Target & "*" Then に書き換えてみてください。

jkallnight
質問者

お礼

出来ました!有難うございます。まだまだ勉強不足でした。部分一致なので*を入れないと駄目だったんですね

関連するQ&A

  • マクロで質問です

    下記のようなマクロで現在はマクロコード内にフォルダのアドレスを書いていますが これをダイアログを開いてフォルダを選択できるようにするには どうすればよいでしょうか? Sub Sample10()    Call FileSearch("V:\個人\飯塚\マクロ\RawData2") End Sub Sub FileSearch(Path As String) Application.ScreenUpdating = False    Dim FSO As Object, Folder As Variant, File As Variant    Set FSO = CreateObject("Scripting.FileSystemObject")    For Each Folder In FSO.GetFolder(Path).SubFolders        Call FileSearch(Folder.Path)    Next Folder    For Each File In FSO.GetFolder(Path).Files        If File.Name = "RawData" Then Workbooks.Open fld & File, Format:=2 Range("B1:B180").Select Application.CutCopyMode = False Selection.Copy Application.DisplayAlerts = False ActiveWindow.Close Application.DisplayAlerts = True Range("f2").Select ActiveSheet.Paste ActiveSheet.Next.Activate End If    Next File End Sub

  • 全ファイル名をセルに出力するVBAプログラム

    VBA初心者です。 Aというディレクトリがあり、その中に1,2,3,4というフォルダがあります。 1には「apple1.csv」、「orange1.csv」、「banana1.csv」 2には「apple2.csv」、「orange2.csv」、「banana1.csv」 ・・・ 4には「apple4.csv」、「orange4.csv」、「banana4.csv」 が入っています。 この1から4のフォルダのapple1,apple2,apple3,apple4のファイルをとりだし、それぞれのA1~A10セルを新たなファイルに自動転記する(apple1はA1~A10,apple2はB10~B10・・・)といった具合のマクロを組みたいと思っています。 そこで以下のHPを参考にし、まずはトップディレクトリである「C:\Sample」の中のすべてのフォルダを表示するプログラムをつくってみようと試みました。 ホームページでは以下のソース Sub Sample() Call FileSearch("C:\Sample") End Sub Sub FileSearch(Path As String) Dim FSO As Object, Folder As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Debug.Print Folder.Path Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す Next Folder End Sub によってイミディエイトにフォルダを表示する仕様になっています。 実際、私もこのソースで実行したところ、イミディエイトにはトップディレクトリ以下の全ディレクトリ名が表示されました。 これを改良し、2列目に全ディレクトリ名が表示されるプログラムを組みました。ソースは以下です。 Sub Sample() Call FileSearch("C:\Sample") End Sub Sub FileSearch(Path As String) Dim FSO As Object, Folder As Variant ' Dim i As Integer ' i = 1 Set FSO = CreateObject("Scripting.FileSystemObject") For i = 1 To FSO.GetFolder(Path).SubFolders Debug.Print Folder.Path Call FileSearch(Folder.Path) ''見つかったフォルダを引数に指定して、自分自身を呼び出す i = i + 1 Cells(i, 2) = Folder Next i End Sub これを実行したところ、2列目にはすべてのディレクトリは表示されず、一部のディレクトリしか表示されません。 改良の仕方がおそらくまずいと思うのですが、何か私が根本的に間違えている気がするので、ご指摘いただけたら幸いです。

  • VBA:2つのCSVファイルを開きたいです。

    エクセル2010のVBAにてCSVファイルを開き結合させるプログラムを組もうとしているのですが、2つ目のCSVファイルを開こうとすると、何故かエラーが出てしまいます。 -------------------------------------------------------------------------------- 1つ目 Sub mobile_FileSearch(Path As String) 'test.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call mobile_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "test.csv" Then Workbooks.Open ("test.csv") End If Next File End Sub ---------------------------------------------------------------------------- 2つ目 Sub local_FileSearch(Path As String) 'bbb.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call local_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "bbb.csv" Then Workbooks.Open ("bbb.csv")'←ここでエラー End If Next File End Sub ------------------------------------------------------------------------ まったく同じプログラムで、csvファイル名だけ変えただけで実行時エラー1004が出てしまいます。 一体全体何が問題なのでしょうか?

  • サブフォルダからエクセルブックをとりだすマクロ

    特定のフォルダからエクセルブックのみを抽出し別のフォルダに集める(コピーする)マクロを作りたいと思い、以下のように作成しました。 (AAAフォルダ⇒移動元、BBBフォルダ⇒移動先) ただしこれだと、AAAフォルダ内にあるサブフォルダからは拾ってこれないようです。 AAA内の全てのサブフォルダからエクセルブックを拾ってくるにはどう修正すればよろしいでしょうか。 ――――――――――― Sub sample1() Dim FSO As Object, fld As Variant, bk As Variant Const Fld1 As String = "C:\AAA" Const Fld2 As String = "C:\BBB\" Const tgt As String = "*.xlsx" Set FSO = CreateObject("Scripting.FileSystemObject") For Each fld In FSO.GetFolder(Fld1).SubFolders For Each bk In fld.Files If bk.Name Like tgt Then bk.Copy Fld2 End If Next bk Next fld End Sub

  • テキストファイルをエクセルに移すマクロのことで?

    以前、複数のテキストファイルをエクセルに移すマクロを教えてもらったのですが、 以下マクロですと、フォルダのパスを指定しないといけません。 今回教えてもらいたいのは、フォルダのパスを指定しなくてもよい方法です。 どういう事かと言うと、仮にディスクトップにフォルダがあるとします。 そのフォルダの中には、マクロが入っているエクセルシートとテキストが入っているフォルダです。 つまり、そのフォルダ内だけで、処理をしたいと考えています。 また、フォルダ名は、その時によって異なります。 今までは、以下の方法を使っていたのですが、ちょっと使いにくいと感じています。 申し訳ありませんが、どなたか教えていただけないでしょうか? Sub Macro() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim FolderPath As String 'ここのアドレスをファイルが格納されているフォルダのパスに変えてください FolderPath = "C:\Users\・・・" Dim myFile As Object Dim i As Long i = 2 Dim myFolder As Object For Each myFolder In fso.GetFolder(FolderPath).SubFolders For Each myFile In fso.GetFolder(myFolder).Files Cells(i, 4).Value = myFolder Cells(i, 1).Value = myFile.Name Cells(i, 7).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next Next End Sub Private Sub CommandButton1_Click() End Sub

  • FSOを使いサブフォルダのファイル操作

    同じ階層のサブフォルダにxlsm入るが入っており、VBAによりモジュールを解放しようと試みています。 まずは、FSOを使ってサブフォルダにアクセスしようとしましたが、下から6行目でエラー(424 オブジェクトが必要です)が出てしまい、解決できませんので、ご教示いただけないでしょうか? よろしくお願いします Sub DeleteMain() With Application.FileDialog(msoFileDialogFolderPicker) If Not .Show Then Exit Sub Call DeleteSub(folderPath:=.SelectedItems(1)) End With End Sub Sub DeleteSub(folderPath As String, Optional mycount As Long = 0) Dim fso As Object, myFolders As Object, myfile As Object Set fso = CreateObject("Scripting.FileSystemObject") Set myFolders = fso.GetFolder(folderPath).SubFolders For Each myfile In fso.GetFolder(folderPath).Files mycount = mycount + 1 ' Cells(mycount, 1) = myfile.Path Debug.Print myfile.Path Next For Each myFolders In fso.GetFolder(folder.Path).SubFolders Call DeleteSub(myFolder.Path, mycount) Next Set fso = Nothing Set myFolders = Nothing End Sub

  • エクセルマクロでフォルダのコピーがしたい

    こんにちわ 色々調べてフォルダのコピーはできたのですが、色々いじっていて分からないことが出てきたので質問に来ました。 やりたいことはフォルダをコピーしたいのですが、それぞれ名前を自動で変えようと思い下記(1)を元に下記(2)を作ってみましたが、動きませんでした。 (1)いくつかのサイトを見て動いたマクロ sub test() Dim myFSO As New FileSystemObject myFSO.CopyFolder "C:\test", "C:\test2" End Sub (2)ちょっといじって動かないマクロ sub test() Dim myFSO As New FileSystemObject Dim name As String Dim name2 As String name = "C:\test" name2 = "C:\test2" myFSO.CopyFolder "name", "name2" End Sub 「パスが見つかりません」と出てきたので、読み込んでいないのだとは思うのですが、どうしたら動くかアドバイスをいただきたいです。 よろしくお願いします。

  • VBAでアクティブなファイルを参照して、ファイル一覧作成(サブフォルダ含む)

    VBAでアクティブなファイルのフォルダ(サブフォルダを含む)のファイル一覧を 作成したいと思っています。 以下のサイトを参考にして、パス、ファイル名を落とすまではできました。 http://okwave.jp/qa3544575.html === Sub test() Application.ScreenUpdating = False Sheet1.Cells.Clear Sheet1.Cells(1, 1) = "パス" Sheet1.Cells(1, 2) = "ファイル名" files "d:\", 2 Application.ScreenUpdating = True End Sub Sub files(path As String, ByRef row As Long) DoEvents Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim f As Object For Each f In fso.GetFolder(path).files Sheet1.Cells(row, 1) = path Sheet1.Cells(row, 2) = f.Name row = row + 1 Next For Each f In fso.GetFolder(path).SubFolders files f.path, row Next Set fso = Nothing End Sub === >files "d:\" の箇所を修正して、アクティブなブックを参照しようとしてみたのですが、 なかなか上手くいきません。 また、できれば *.xls などファイルの種類を指定したいのです。 filesearchを使用して組んだ時は 「AAA = ActiveWorkbook.path」「Filetype ~ 」 などでそれらの指定ができたのですが、上記に応用する事ができません。 どなたかご教示頂けますよう、よろしくお願いいたしますm(_ _)m

  • EXCEL2000 フォルダ内のファイルを検索

    EXCEL2000 フォルダ内のファイルを検索 お分かりになる方がいましたらお力添えの程よろしくお願いします。 任意のフォルダ内で任意のファイルサーチが出来るマクロを実行したいのですが、ファイルサーチの値を全角、半角、大文字、小文字区別なく行いたいのです。 例えば,セル2,2に、topと入力したら、topもtopもTOPもTOPも検索対象に引っかかり、セルに書き出して欲しいのです。 ・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・ Sub ファイル一覧2() Dim vntF As Variant Dim objFS As FileSearch Dim objFSO As FileSystemObject Dim GYO As Long Dim cntFound As Long Set objFS = Application.FileSearch ' FileSearch Set objFSO = New FileSystemObject ' FSO Rows("5:65536").ClearContents Application.ScreenUpdating = False GYO = 4 With objFS .NewSearch .LookIn = Trim(Cells(1, 2).Value) ' Search開始フォルダ .Filename = Trim(Cells(2, 2).Value) ' 探索ファイル式 .SearchSubFolders = True ' サブフォルダも探索 ' 処理開始 If .Execute() <> 0 Then For Each vntF In .FoundFiles With objFSO.GetFile(vntF) GYO = GYO + 1 Cells(GYO, 1).Value = .Name Cells(GYO, 2).Value = .DateLastModified Cells(GYO, 3).Value = _ Left(.Path, Len(.Path) - Len(.Name) - 1) cntFound = cntFound + 1 End With Next vntF End If End With Set objFS = Nothing Set objFSO = Nothing ' 処理結果の表示 If cntFound = 0 Then MsgBox "見つかりません" Else MsgBox cntFound & "個見つかりました" End If End Sub

  • マクロで特定のフォルダの中から任意のフォルダを開きたい

    マクロで特定のフォルダの中から、任意のフォルダを開きたいのです。 または、特定のフォルダの中から最新のブックを開きたいのですが このような方法ご存知の方ご教示いただけませんでしょうか^^; 以下のコードは、似たような方法がないか検索して 見つけたマクロなのですが、この方法ですと 特定のフォルダを指定して開くことはできますが 任意のフォルダを一発で開くということは難しいようです。 Private Sub Worksheet_BeforeDoubleClick() Cancel = True Const dataDir As String = "C:\テスト\保存データ\" Dim dataFilePath As String dataFilePath = dataDir & Target.Value & ".xls" Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(dataFilePath) Then Workbooks.Open (dataFilePath) End If 保存データというフォルダに番号がフォルダ名のフォルダが複数入っています。 例) 100 101 102 103 104 と、いった具合です。 保存フォルダの中の104(任意のフォルダ)を開くマクロまたは番号のフォルダは関係なく 保存フォルダの中の最新ブックを開くことができるような方法はないでしょうか? 開きたいブックというのは、最新ブックのみですので、この例の場合 104が最新のフォルダというわけではなく、番号のフォルダ自体は 104以降もあり、最新ファイルが104にある場合は105以降のフォルダは 空の状態です。 分かりにくい説明ではございますが、よろしくお願いします^^;

専門家に質問してみよう