| |
▼ichinose さん：
丁寧なアドバイスありがとうございます。
早速以下のモジュールを組み込んで試してみたいと思います。
（以下の処理は私が行いたい処理に近いので自分用に書き換えて使ってみようと思います。私がＶＢＡで作ろうとしているツールは、テキストファイル（内容：ファイルパスとそのファイル更新日一覧リスト）を読み込んで、読み込んだファイルパスのファイルが、そのツールを実行しているＰＣ内に存在するものとして、テキストファイルのファイルパスからファイル名を取得し、そのファイル名からファイルパスを取得し直し、正しいファイルパスが取得できたらそのファイルの属性（ファイル更新日）を取得して、リストのファイル更新日と実際に取得したファイル更新日のコンペアを取りたいのです。ほかにいい方法があればまたご教授願いたいものですが・・・）
>こんばんは。
>
>>たびたびすいません、下記についてその逆はできないでしょうか？
>>（ファイル名のみでフルパスを取得する方法）
>>自分でも調べてみて色々試しているのですが何分VBAに関してはずぶの初心者なものでして・・・
>>これは無理です。
>>カレントディレクトリやBookと同じフォルダにあるファイルであれば可能ですけど。
>>(これができたら、フォルダＡのtest.txtとフォルダＢのtest.txtのどっちかどう区別
>>するのってこと)
>
>Blueさんのおっしゃるとおりですが・・・、
>指定されたファイル名でドライブの各フォルダをサーチするという事なら、
>
>標準モジュールに
>'===========================================================
>Sub main()
> Dim sflnm As Variant
> Dim ans As Long
> Dim flnm As String
> dim i as long
> Cells.ClearContents
> sflnm = Application.InputBox("サーチするファイル名")
> If TypeName(sflnm) = "Boolean" Then Exit Sub
> ans = fold_open("d:\", sflnm, False)
> If ans = 0 Then
> flnm = fold_get()
> Do While flnm <> ""
> Cells(i + 1, 1).Value = flnm
> i = i + 1
> flnm = fold_get
> Loop
> Else
> If ans = 1 Then
> MsgBox "見つからない"
> Else
> MsgBox Error(ans)
> End If
> End If
> Call fold_close
>End Sub
>
>
>別の標準モジュールに
>'==========================================================
>Private f_cnt As Long
>Private f_path() As String
>Private f_idx As Long
>Function fold_open(ByVal stDir As String, ByVal f_file As String, ByVal 捜索階層) As Long
>'指定されたパスを捜索開始パスとして、指定されたファイルを捜索します
>'尚、ファイル名の大文字・小文字は区別しません
>'input : stDir-----捜索開始パス
>' f_file----捜索ファイル名
>' 捜索階層---False-----開始パスから全ての階層を捜索する
>' 数値（>0）-開始パスから指定された階層のフォルダを捜索する（1の場合は､開始パスのみ）
>'output : fold_open 0--------条件に合ったファイルが1つ以上見つかった
>' 1--------条件に合ったファイルは見つからない
>' その他---以上終了（エラーコード）
> On Error Resume Next
> Dim fso As Object
> Dim f_fld As Object
> fold_open = 0
> Erase f_path()
> Set fso = CreateObject("Scripting.FileSystemObject")
> Set f_fld = fso.GetFolder(stDir)
> If Err.Number <> 0 Then
> fold_open = Err.Number
> Else
> f_cnt = 0
> Call fold_search(f_fld, f_file, 捜索階層)
> If f_cnt <= 0 Then
> fold_open = 1
> Else
> f_idx = 1
> End If
> End If
> Set fso = Nothing
> Set f_fld = Nothing
>End Function
>'========================================================================
>Sub fold_search(ByVal f_fld As Object, ByVal f_file As String, ByVal 捜索階層)
> Dim sfld As Object
> Dim fl As Object
> Dim ret As Boolean
> For Each fl In f_fld.Files
> If UCase(fl.Name) Like UCase(f_file) Then
> ReDim Preserve f_path(1 To f_cnt + 1)
> f_path(f_cnt + 1) = fl.Path
> f_cnt = f_cnt + 1
> End If
> Next fl
> If VarType(捜索階層) = vbBoolean Then
> ret = True
> Else
> If 捜索階層 - 1 > 0 Then
> 捜索階層 = 捜索階層 - 1
> ret = True
> Else
> ret = false
> End If
> End If
> If ret = True Then
> For Each sfld In f_fld.SubFolders
> Call fold_search(sfld, f_file, 捜索階層)
> Next
> End If
>End Sub
>'===================================================================
>Function fold_get() As String
>'fold_openが0だった場合､順次見つかったファイルのフルパスを取り出す
>'output: fold_get-----条件に合ったファイルのフルパス。空白の場合は、データの終わり
> If f_idx > UBound(f_path()) Then
> fold_get = ""
> Else
> fold_get = f_path(f_idx)
> f_idx = f_idx + 1
> End If
>End Function
>'===========================================================
>Sub fold_close()
>'ファイル捜索のクローズ処理
> Erase f_path
> f_idx = 0
> f_cnt = 0
>End Sub
>
>
>でmainを実行してみてください。
>
>入力を求められますから、調べるファイル名を指定してください
>（例、Book1.Xls Test.Txt 等）
>
>ＯＫボタンクリックで Ｄドライブをサーチします。
>サーチ結果をアクティブシートのＡ列（Ａ１〜）にフルパスで出力します。
>
>こういうことではないですか？
|
|
vbvb
- 06/7/4(火) 9:34 -
