ここから本文です

VBAでのファイルの検索方法 VBAでのファイルの検索方法について悩んでます。

kit********さん

2017/3/1122:03:37

VBAでのファイルの検索方法

VBAでのファイルの検索方法について悩んでます。

例えば、ファイルA.xlsxのパスが
"C:\Users\●●●●●●●●●●●●\ファイルA.xlsx"
だとします。
●の部分は不明で、途中で1~3階層程度のディレクトリを挟んでいます。
(具体的に何階層のディレクトリを挟んでいるかは不明とします)
また、ファイルA.xlsx はそのドライブで一意のファイル名で、重複はありません。
つまり、判明しているのはファイル名と途中までのパス("C:\Users\")のみです。
この状況で、ファイルAの絶対パスを特定することは可能なのでしょうか?

閲覧数:
143
回答数:
4

違反報告

ベストアンサーに選ばれた回答

kik********さん

2017/3/1217:43:56

以下でどうなりますか

全体的に階層を落としながら探してみました
再帰の場合は、見つかった後の処理を工夫しないと・・・
探す階層数は設定しておいた方が、見つからない時の応答は速いかも?
多めに見て 5 階層分にしてみるとか・・・・

なお、アクセスできないフォルダ用の処理は全く記述してません


Option Explicit

Public Sub Samp1()
   Dim oFso As Object, dic As Object
   Dim vK As Variant, vF As Variant, v As Variant
   Dim i As Long, j As Long, k As Long
   Const CFILE As String = "ファイルA.xlsx" ' 探すファイル名
   Const CPATH As String = "C:\Users" ' 初期パス
   Const CC As Long = 3 ' 探す階層数( CPATH は 1階層目)

   Set oFso = CreateObject("Scripting.FileSystemObject")
   Set dic = CreateObject("Scripting.Dictionary")
   dic.Add 0, CreateObject("Scripting.Dictionary")
   dic.Add 1, CreateObject("Scripting.Dictionary")

   dic(0)(CPATH) = Empty
   j = 0
   k = 0
   Do While ((k < CC) And (IsEmpty(v)))
      i = j
      j = 1 - i
      If (dic(i).Count = 0) Then Exit Do
      dic(j).RemoveAll
      For Each vK In dic(i).Keys
         If (oFso.FileExists(vK & "\" & CFILE)) Then
            v = vK & "\" & CFILE
            Exit For
         Else
            For Each vF In oFso.GetFolder(vK).SubFolders
               dic(j)(vF.Path) = Empty
            Next
         End If
      Next
      k = k + 1
   Loop

   If (IsEmpty(v)) Then v = "見つからず"
   MsgBox v

   Set oFso = Nothing
   Set dic = Nothing
End Sub

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜3件/3件中

並び替え:回答日時の
新しい順
|古い順

kmk********さん

2017/3/1421:23:06

まず可能かどうかで 可能です。

再帰定義を使えば簡単にできますよ。
再帰定義についてはWikiなどを見てください。


Sub Absolute_PathGet()
Dim msg As String
Dim File As String

File = "ファイルA.xlsx"
msg = FSearch(File, "C:\Users\")
MsgBox File & "の絶対パスは" _
& vbCrLf & msg & vbCrLf & "です"
End Sub


Function FSearch(FileName As String, Path As String) As String

Dim SF As String
Dim FSO As Object
Dim Folder As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
Path = Path & "\"

SF = Dir(Path & FileName)
If SF <> "" Then
FSearch = Path & FileName
Exit Function
End If
SF = ""
For Each Folder In FSO.GetFolder(Path).SubFolders
SF = FSearch(FileName, Path & Folder.Name)
If SF <> "" Then
FSearch = SF
Exit Function
End If
Next Folder

End Function

Function 内で行っている手順としては
まずPath でしていされたフォルダの中に検索対象のファイルがあるか検索
無ければ Path内の各フォルダに対して上記と同じ処理を
見つかったら絶対パスを文字列として返す。

こんな感じでどうでしょうか?

プロフィール画像

カテゴリマスター

lin********さん

2017/3/1212:39:13

「VBA」でやるとやっかいなので、「VBScript」で組みました。

したがって、「Windows限定」です。

以下のプログラムをメモ帳かテキストエディタに貼り付け、「~.vbs」という名前で保存します。

「~」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず半角です。

できたプログラムファイル(「~.vbs」ファイル)を、「C:\Users」フォルダに放り込んで、ダブルクリック(「シングルクリック」→「Enter」の方が確実)すれば、結果を表示します。

このプログラムのメリットは、調べたいフォルダ群の直上のフォルダに放り込んで、ダブルクリックするだけで、結果が得られますので、汎用性が高いと思います。

Option Explicit
Public f, s, x, y
Set s = CreateObject("Scripting.FileSystemObject")
Set f = s.GetFolder(".")
Call z
Set f = Nothing
Set s = Nothing

Sub z
For Each x In f.SubFolders
For Each y In x.Files
If y.Name = "ファイルA.xlsx" Then
MsgBox(x)
Exit Sub
End If
Next
Set f = s.GetFolder(x.Path)
Call z
Next
End Sub

簡単な説明です。

Option Explicit

「厳密に」というような意味ですが、気にしないでください。

Public f, s, x, y

通常、変数は、「Dim」によって宣言しますが、今回は「Public」で宣言しています。

これで宣言すると、このプログラムでサブプロシージャの中でも共通で使えます。

こうすることで、サブプロシージャに変数を引き渡す必要がなくなるのです。

Set s = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしています。

Set f = s.GetFolder(".")

プログラムファイル(「~.vbs」ファイル)自身が存在するフォルダを取得しています(今は「C:\Users」のはずです)。

Call z

「z」サブプロシージャを呼び出しています。

Sub z

以後、「z」サブプロシージャです。

For Each x In f.SubFolders

最初は、プログラムファイル(「~.vbs」ファイル)自身の存在するフォルダ(「f」)についての、直下のサブフォルダを1つずつ調べます。

For Each y In x.Files

みつかったサブフォルダの中のすべてのファイルを1つずつ処理します。

If y.Name = "ファイルA.xlsx" Then

みつかったファイルが「ファイルA.xlsx」だったら、

MsgBox(x)

みつかったフォルダを表示します(このとき、ちゃんと「C:\」から表示します。

Exit Sub

サブフォルダを抜け出しています(結果的に終了します)。

Set f = s.GetFolder(x.Path)

見つからなかった場合は、新たなサブフォルダを調べるために、今現在のパスをゲットしています。

Call z

自分自身「z」サブプロシージャを呼び出しています。

このように、自分自身を呼び出す構造を「再帰的」といいます。

こうして、すべてのサブフォルダを調べることができます。

を繰り返しています。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

プロフィール画像

カテゴリマスター

tra********さん

2017/3/1123:16:32

全件検査しかないでしょうね、きっと。
「C:\AAA」配下の「ファイルA.xlsx」を検索する例です。

Const cFile As String = "ファイルA.xlsx"
Dim xEnd As Boolean
Sub Sample_Main()
Dim FSO, xFld
Const cFld As String = "C:\AAA\"
xEnd = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set xFld = FSO.GetFolder(cFld)
Call Sample_Folder_Proc(xFld)
Set FSO = Nothing
End Sub

Sub Sample_Folder_Proc(xFld)
Dim xFile As Object, sh As Worksheet, xSubFld As Object

For Each xFile In xFld.Files
If xFile.Name = cFile Then
MsgBox cFile & "は," & xFld.Path & "に存在します"
xEnd = True
Exit For
End If
Next xFile
If Not xEnd Then
For Each xSubFld In xFld.subfolders
Call Sample_Folder_Proc(xSubFld)
If xEnd Then Exit For
Next xSubFld
End If
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる