VBScriptでファイル検索
- VBScriptを使用してファイルを検索する方法についての質問です。
- スクリプトを作成し、「あいうえお.xls」ファイルのパスを表示できない問題に遭遇しました。
- どこに不具合があるのか、教えていただけませんか？
- ベストアンサー
VBScriptでファイル検索
こんにちは。 Ｄドライブのどこかにある「あいうえお.xls」ファイルのパス をメッセージ表示するようなスクリプトを作りましたが、上手 く表示されません。どこに不具合があるのか、ご教授ください。 お願いいたします。 Option Explicit Dim FSO,File,SubFolder Set FSO = CreateObject("Scripting.FileSystemObject") ShowSubfolders FSO.GetFolder("D:\") Sub ShowSubFolders(Folder) For Each File in Folder.Files If File.Name = "あいうえお.xls" then Wscript.Echo File.path End If Next For Each Subfolder in Folder.SubFolders ShowSubFolders Subfolder Next Set FSO = Nothing End Sub
- enako
- お礼率62% (298/476)
- その他（プログラミング・開発）
- 回答数3
- ありがとう数2
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
訂正です。 X = Folder.Files ↓ X = Folder.Files.Count
その他の回答 (2)
- nda23
- ベストアンサー率54% (777/1415)
アクセス権限が無いためでしょう。 次の文を追加してみてください。 '== ここから == Dim X On Error Resume Next X = Folder.Files On Error GoTo 0 If IsEmpty(X) Then Exit Sub '== ここまで == For Each File ～
- nda23
- ベストアンサー率54% (777/1415)
Set FSO = Nothing End Sub ↓ End Sub Set FSO = Nothing
補足
nda23さん、こんにちは。ご指導ありがとうございます。 そのご指摘とは別に、スクリプトを実行しようとすると、 For Each File in Folder.Files のところで、 「実行時エラー：書き込みできません」で実行できません。 試しに、If File.Name = "あいうえお.xls" の条件をとると、 実行しファイルのパスを表示するのですが、Ｄドライブに存在 している７つあるフォルダの内、１つのフォルダとRECYCLER(ごみ箱?) というフォルダを表示後、「実行時エラー：書き込みできません」で 停止してしまいます。OSはWindowsXP WSHのバージョンは5.7で実行 しております。引き続きご教授いただければ幸いです。 よろしくお願いいたします。
関連するQ&A
- 再帰処理でアクセス禁止フォルダが存在した際の対応
こんにちは。 ファイルの一覧を表示するモジュールを作成しました。 その際、アクセスが禁止されるフォルダ(何かのきっかけで 作成されたフォルダ。削除できません。）があった場合、 For Each subfolder In folder.SubFoldersの行で、 「書き込みできません」で停止してしまいます。 このフォルダを削除しないで(存在させたままで)処理を継続 することは可能でしょうか？ よろしくご教授願います。 Dim fso As Object Dim folder As Object Dim subfolder As Object Dim file As Object Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(strTargetDir) For Each subfolder In folder.SubFolders FolderSearch subfolder.Path Next subfolder For Each file In folder.Files With file Debug.Print .Path End With Next file
- ベストアンサー
- その他（プログラミング・開発）
- 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が出てしまいます。 一体全体何が問題なのでしょうか？
- ベストアンサー
- その他（プログラミング・開発）
- VBSで指定したフォルダー内のファイルを書き出さないようにする
あるフォルダ以下のファイル名を出力ファイル、f.name.txtに書き出すのですが "新しいフォルダ"というフォルダのなかにあるファイルは書き出さないようにしたいのですが、意に反してフォルダー内の全てのファイル名を書き出してしまいます。どこがおかしいのでしょう? ********************************************** Set FSO = CreateObject("Scripting.FileSystemObject") Set fl = WScript.CreateObject("Scripting.FileSystemObject") Set abc = fl.CreateTextFile("f.name.txt") ShowSubfolders FSO.GetFolder(".") Sub ShowSubFolders(Folder) For Each File in Folder.Files 'Folder内のファイルを列挙する Fname = File.name FolderCheck=Folder & "\" & "新しいフォルダ" If Folder <> FolderCheck Then abc.Write Folder & "\" & Fname & vbCrLf End If Next For Each Subfolder in Folder.SubFolders 'Foler内のフォルダを列挙する ShowSubFolders Subfolder '再帰呼び出し Next End Sub abc.Close
- ベストアンサー
- その他（プログラミング・開発）
- 再度:VBSで指定したフォルダー内のファイルを書き出さないようにする
先ほども似たような質問をしました。 あるフォルダの中にあるファイル名の一覧をファイル"f.name.txt"を書き出したいのですが"新しいフォルダ"のなかにあるファイルは書き出さないようにしたいです。下記のVBSは"新しいフォルダ"のなかに更にフォルダが階層的に存在するときには"新しいフォルダ"の中のファイルも全て書き出してしまいます。 "新しいフォルダ"の中にフォルダがない場合は正しく動きます。 "新しいフォルダ"の中にフォルダが階層的にあっても"新しいフォルダ" の中にあるファイル名を書き出さないようにするにはどうしたらよいのでしょう? ************************************************************** Set FSO = CreateObject("Scripting.FileSystemObject") Set fl = WScript.CreateObject("Scripting.FileSystemObject") Set abc = fl.CreateTextFile("f.name.txt") ShowSubfolders FSO.GetFolder(".") Sub ShowSubFolders(Folder) If Folder.Name <> "新しいフォルダ" Then For Each File in Folder.Files 'Folder内のファイルを列挙する Fname = File.name abc.Write Folder & "\" & Fname & vbCrLf Next End If For Each Subfolder in Folder.SubFolders 'Folder内のフォルダを列挙する ShowSubFolders Subfolder '再帰呼び出し Next End Sub abc.Close
- ベストアンサー
- その他（プログラミング・開発）
- 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
- ベストアンサー
- Excel（エクセル）
- サブフォルダ内のファイル名取得について
Windows7 Access 2013環境です。 USB接続したハードディスク内のファイルリストを作成しようとしています。 ハードディスクはNTFSフォーマットです。 ボタン1をクリックしたとき、テーブル1をソースにしたフォーム1に ファイル名を書き出していくようにしました。 ドライブ内のサブフォルダを選択すると、プログラムは正常に作動するのですが ドライブ直下を指定すると、実行時エラー 70 "書き込みできません" が発生します。 NTFSのアクセス権は、管理者でログインしているので、システム関連のフォルダ System Volume Information $RECYCLE.BIN 以外は問題ありません。 どこに問題があるのでしょうか。もし、システム関連のフォルダが 引っかかっているとしたら、その回避方法についても 具体的にご教授願います。 ↓エラー箇所↓ -------------------------------------------------------------- For Each subfolder In folder.SubFolders -------------------------------------------------------------- ↓作成したプログラム↓ -------------------------------------------------------------- Private Sub ボタン_1_Click() Dim dlg As FileDialog Dim fold_path As String Dim strTargetDir As String DoCmd.GoToRecord acDataForm, "F0001_フォーム1", acNewRec Set dlg = Application.FileDialog(msoFileDialogFolderPicker) If dlg.Show = False Then Exit Sub fold_path = dlg.SelectedItems(1) strTargetDir = fold_path Call FolderSearch(strTargetDir) MsgBox "終了" Set dlg = Nothing Else End If End Sub Public Sub FolderSearch(strTargetDir As String) Dim fso As Object Dim folder As Object Dim subfolder As Object Dim file As Object Dim objFilsSys As Object Dim objDrive As Object Dim strDriveLetter As String Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(strTargetDir) strDriveLetter = Left(strTargetDir, 1) Set objFileSys = CreateObject("Scripting.FileSystemObject") Set objDrive = objFileSys.GetDrive(strDriveLetter) For Each subfolder In folder.SubFolders ←エラー箇所 FolderSearch subfolder.Path Next subfolder For Each file In folder.Files With file Me.ボリューム名 = objDrive.VolumeName Me.ファイル名 = file.Name Me.ファイルパス = folder.Path Me.ファイルサイズ = folder.Size DoCmd.GoToRecord acDataForm, "F0001_フォーム1", acNewRec End With Next file Set objDrive = Nothing Set fso = Nothing Set folder = Nothing 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
- ベストアンサー
- オフィス系ソフト
- VBS サブフォルダの再帰処理について
VBScriptでファイルリストを出力しようと考えています。 そこでフォルダ内のファイルを再帰的に検索したいのですが、上手くいきません。 C:\A\B\C\D\○○.txt C:\A\BB\C\D\××.txt C:\A\BBB\C\D\△△.txt のようにB,BB,BBBの部分のみ可変にしたいのです。 例えば C:\A\B\CC\D\○○.txt C:\A\B\CCC\D\○○.txt のような B以外のフォルダのサブフォルダについては再帰検索はいきたくありません。 （A,C ,D については引数で与えようと考えています。） よいロジックはないでしょうか？ ご存知の方がいらっしゃいましたらぜひ教えてください。 出力形式は ファイル名,作成日時 以下 色々参考にして作成したプログラム。 これだと指定フォルダ以下すべて検索にいってしまいます(-_-;) --------------------------------------------------------------- Dim fso Dim folder Set fso = CreateObject("Scripting.FileSystemObject") Dim pass pass ="C:\" & args.item(0) & "\" Dim subFolder For Each subFolder In folder.SubFolders ShowSubfolders FSO.GetFolder(pass) Next Sub ShowSubFolders(Folder) Dim file For Each file In folder.Files WScript.Echo _ file.Name & "," & _ file.DateCreated Next For Each subFolder In folder.SubFolders ShowSubFolders subFolder Next End Sub
- 締切済み
- その他（プログラミング・開発）
- マクロで質問です
下記のようなマクロで現在はマクロコード内にフォルダのアドレスを書いていますが これをダイアログを開いてフォルダを選択できるようにするには どうすればよいでしょうか？ 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
- ベストアンサー
- Excel（エクセル）
- 部分検索でフォルダ名を検索するマクロ
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
- ベストアンサー
- Excel（エクセル）
お礼
nda23さん、こんにちは。 教えていただいたコードで上手く実行されました！ 更にＷＳＨについて学を深めたいと思います。 どうもありがとうございました。