Excel VBA質問箱 IV

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

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


7308 / 13644 ツリー ←次へ | 前へ→

【39747】VBAでファイル名抽出 vbvb 06/6/30(金) 13:08 質問[未読]
【39748】Re:VBAでファイル名抽出 Blue 06/6/30(金) 13:17 回答[未読]
【39751】Re:VBAでファイル名抽出 vbvb 06/6/30(金) 13:55 お礼[未読]
【39763】Re:VBAでファイル名抽出 vbvb 06/6/30(金) 17:35 質問[未読]
【39765】Re:VBAでファイル名抽出 Blue 06/6/30(金) 17:39 発言[未読]
【39769】Re:VBAでファイル名抽出 ichinose 06/6/30(金) 19:48 発言[未読]
【39909】Re:VBAでファイル名抽出 vbvb 06/7/4(火) 9:34 お礼[未読]
【39906】Re:VBAでファイル名抽出 vbvb 06/7/4(火) 9:17 お礼[未読]

【39747】VBAでファイル名抽出
質問  vbvb  - 06/6/30(金) 13:08 -

引用なし
パスワード
   はじめまして、質問させてください。
あるセルに入力されたファイルパス(フルパス)からファイル名だけを抽出できる方法って何かありますでしょうか?ご存知の方いらっしゃいましたらアドバイスお願いします。

【39748】Re:VBAでファイル名抽出
回答  Blue  - 06/6/30(金) 13:17 -

引用なし
パスワード
   ファイル名は拡張子付でしょうか?
でしたら、Dir関数が一番簡単です。

参考)
ファイル名だけを取得するには
http://park7.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200603/06030300.txt

【39751】Re:VBAでファイル名抽出
お礼  vbvb  - 06/6/30(金) 13:55 -

引用なし
パスワード
   Blueさん
下記のURLを参照したら解決しました。
ありがとうございましたm(_ _)m。

▼Blue さん:
>ファイル名は拡張子付でしょうか?
>でしたら、Dir関数が一番簡単です。
>
>参考)
>ファイル名だけを取得するには
>http://park7.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200603/06030300.txt

【39763】Re:VBAでファイル名抽出
質問  vbvb  - 06/6/30(金) 17:35 -

引用なし
パスワード
   たびたびすいません、下記についてその逆はできないでしょうか?
(ファイル名のみでフルパスを取得する方法)
自分でも調べてみて色々試しているのですが何分VBAに関してはずぶの初心者なものでして・・・

▼vbvb さん:
>はじめまして、質問させてください。
>あるセルに入力されたファイルパス(フルパス)からファイル名だけを抽出できる方法って何かありますでしょうか?ご存知の方いらっしゃいましたらアドバイスお願いします。

【39765】Re:VBAでファイル名抽出
発言  Blue  - 06/6/30(金) 17:39 -

引用なし
パスワード
   ▼vbvb さん:
>たびたびすいません、下記についてその逆はできないでしょうか?
>(ファイル名のみでフルパスを取得する方法)
これは無理です。
カレントディレクトリやBookと同じフォルダにあるファイルであれば可能ですけど。
(これができたら、フォルダAのtest.txtとフォルダBのtest.txtのどっちかどう区別するのってこと)

【39769】Re:VBAでファイル名抽出
発言  ichinose  - 06/6/30(金) 19:48 -

引用なし
パスワード
   こんばんは。

>たびたびすいません、下記についてその逆はできないでしょうか?
>(ファイル名のみでフルパスを取得する方法)
>自分でも調べてみて色々試しているのですが何分VBAに関してはずぶの初心者なものでして・・・
>これは無理です。
>カレントディレクトリやBookと同じフォルダにあるファイルであれば可能ですけど。
>(これができたら、フォルダAのtest.txtとフォルダBの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 等)

OKボタンクリックで Dドライブをサーチします。
サーチ結果をアクティブシートのA列(A1〜)にフルパスで出力します。

こういうことではないですか?

【39906】Re:VBAでファイル名抽出
お礼  vbvb  - 06/7/4(火) 9:17 -

引用なし
パスワード
   ▼Blue さん:
ご返信ありがとうございます。
>(これができたら、フォルダAのtest.txtとフォルダBのtest.txtのどっちかどう区別するのってこと)
自分でもぐぐってみたらほとんど上記のような理由でできないという結果でした。
説明不足で申し訳なかったですがあるファイルに対して必ずしもひとつのファイルパスでなくても複数あってもいいということでした。

>▼vbvb さん:
>>たびたびすいません、下記についてその逆はできないでしょうか?
>>(ファイル名のみでフルパスを取得する方法)
>これは無理です。
>カレントディレクトリやBookと同じフォルダにあるファイルであれば可能ですけど。
>(これができたら、フォルダAのtest.txtとフォルダBのtest.txtのどっちかどう区別するのってこと)

【39909】Re:VBAでファイル名抽出
お礼  vbvb  - 06/7/4(火) 9:34 -

引用なし
パスワード
   ▼ichinose さん:
丁寧なアドバイスありがとうございます。
早速以下のモジュールを組み込んで試してみたいと思います。
(以下の処理は私が行いたい処理に近いので自分用に書き換えて使ってみようと思います。私がVBAで作ろうとしているツールは、テキストファイル(内容:ファイルパスとそのファイル更新日一覧リスト)を読み込んで、読み込んだファイルパスのファイルが、そのツールを実行しているPC内に存在するものとして、テキストファイルのファイルパスからファイル名を取得し、そのファイル名からファイルパスを取得し直し、正しいファイルパスが取得できたらそのファイルの属性(ファイル更新日)を取得して、リストのファイル更新日と実際に取得したファイル更新日のコンペアを取りたいのです。ほかにいい方法があればまたご教授願いたいものですが・・・)

>こんばんは。
>
>>たびたびすいません、下記についてその逆はできないでしょうか?
>>(ファイル名のみでフルパスを取得する方法)
>>自分でも調べてみて色々試しているのですが何分VBAに関してはずぶの初心者なものでして・・・
>>これは無理です。
>>カレントディレクトリやBookと同じフォルダにあるファイルであれば可能ですけど。
>>(これができたら、フォルダAのtest.txtとフォルダBの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 等)
>
>OKボタンクリックで Dドライブをサーチします。
>サーチ結果をアクティブシートのA列(A1〜)にフルパスで出力します。
>
>こういうことではないですか?

7308 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free