FileSearchが使えなくなり困ってます（2回目）

質問

QNo.5523274の者です。まだ出来ず、悩んでます。
選択したセル値がファイル名（拡張子抜き）を指定の保存先から検索して呼び出したいのですが、該当なしまでは表示されるのですが、見つかった場合のファイルが開きません。
どこをなおしたらよいかアドバイスいただけないでしょうか。
どうか回答をお願い致します。

'指定したセルを検索する。
Dim p As Range, mypath As String
For Each p In Selection

'データがなければ抜ける。
If p = "" Then
Exit Sub
End If

'選択したセルが存在するか確認後、ファイルを開く。
mypath = "C:\保存先\"

If Dir(mypath & p) <> "" Then
If MsgBox("開きますか", vbYesNo) = vbNo Then Exit Sub
Set book = Workbooks.Open(mypath & p)
Else
MsgBox ("検索結果：該当なし")

End If
Next p
End Sub

素人ゆえ、上記文章手直ししていただけると大変助かります。

回答No.6

hige_082 · ベストアンサー

＞元の値に“.ｘｌｓ”が付く形になりましたが、元の値はそのままにしておきたい
前回の修正を元に戻してください
そして、下記の２行を修正してください

＞If Dir(mypath & p) <> "" Then
If Dir(mypath & p & ".xls*") <> "" ThenI

＞Set book = Workbooks.Open(mypath & p)
Set book = Workbooks.Open(mypath & Dir(mypath & p & ".xls*"))

＞“.xlsm”も“.xls”と混ざって保存されてる場合にどっちの拡張子も開くには
例えば、test.xlsmとtest.xlsの両方が存在する場合があるの？
有る場合はどちらを開くのでしょうか？
それとも、両方開くのでしょうか？
上記の修正では.xlsを優先して開きます

他の方の回答を参考にされるなら、無視してください

お礼

hige_082さん

早々の回答ありがとうございます。
両方の存在はありません、優先して開くとのことで理解ができました。
またも自分の質問が素人過ぎる内容と実感いたしました。

おかげさまで解決できそうです。
年末時お忙しいところ、目にとめていただきありがとうございました。

本当にどうもありがとうございました。

回答No.5

temtecomai2

勝手に仕様を脳内作成。

1. セルに記述されているファイル名が特定の場所に実在すれば開く。
2. ファイル名を記述できるセルは複数個所あるので、複数セルを選択した状態でマクロを実行した場合、ヒットした複数のファイルを開く。
3. 開く対象のファイルは Excel のファイルである。
4. セルに記述するファイル名には拡張子を含めない。
5. 拡張子は ".xls" である。
6. サブフォルダーを含めない。

Const baseDir = "d:\保存先"
Const extension = ".xls"

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim targetFilePath As String
Dim p As Range
For Each p In Selection
targetFilePath = fso.BuildPath(baseDir, p.Value) & extension
If fso.FileExists(targetFilePath) Then
Workbooks.Open targetFilePath
End If
Next

仕様 4 を変更。
4. セルに記述するファイル名には拡張子を含める。
5. 仕様削除

Const baseDir = "d:\保存先"

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim targetFilePath As String
Dim p As Range
For Each p In Selection
targetFilePath = fso.BuildPath(baseDir, p.Value)
If fso.FileExists(targetFilePath) Then
Workbooks.Open targetFilePath
End If
Next

さらに仕様変更
3. 開く対象のファイルは Excels に限らず、Word や PDF など、Windows に登録されている種類のファイルである。
4. セルに記述するファイル名には拡張子を含める。
5. 仕様削除

Const baseDir = "d:\保存先"

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim wshell As Object
Set wshell = CreateObject("WScript.Shell")

Dim targetFilePath As String
Dim p As Range
For Each p In Selection
targetFilePath = fso.BuildPath(baseDir, p.Value)
If fso.FileExists(targetFilePath) Then
wshell.Run targetFilePath
End If
Next

お礼

temtecomai2さん

回答ありがとうございます。
お目にとめていただきありがとうございました。
おかげさまで解決できそうです。
アドバイスの仕方もとても分かりやすく、私も質問するときにはこのようにするべきと勉強になりました。

どうもありがとうございました。

回答No.4

Wendy02

こんにちは。

少し、あせっていらっしゃったようですね。状況は良く理解できましたので、もう、前任者さんのコードは完全に改めてしまってもよいでしょう。

もともと、コードの仕様自体が明確なので、思ったとおりに戻せます。

ただ、こちらは、もともとはVBカテゴリですから、場合によっては、Office カテゴリのほうがレスが多いかもしれません。もちろん、私も時間が取れれば、どちらでもレスはつけます。

>選択したセル値がｐの場合を開くにはどこに付け加えればよろしいでしょうか？
※の変更部分をみてください。

セルでファイルを選択する場合は、データ--入力規則--リスト　などで選択させてもよいのですが、
コントロールツールの、コンボボックスで選択させると、CommandButton の必要がありません。

>拡張子“xlsm”も同じファイル先に保存された場合
そのまま、"Test1.xlsm" とセルに入れればよいです。

なお、
'Application.DefaultFilePath & "\"
これは、オプションで、通常ブックを入れてあるフォルダのことを意味しています。

'-------------------------------------------
Sub TestMacro()
　　Dim myPath As String
　　Dim p As Variant
　　myPath = "C:\保存先\" 'Application.DefaultFilePath & "\"
　　p = Worksheets("Sheet1").Range("A1").Value '※　変更部分
　　If Dir(myPath & p) <> "" Then
　　　　Workbooks.Open mypath & p
　　Else
　　　　MsgBox myPath & p & "は見つかりません。"
　　End If
End Sub

お礼

Wendy02さん　

早々の回答ありがとうございます。
質問以外のことでも丁寧に教えていただき感謝致します。
今後お世話になるときに役立てたいと思います。

年末時お忙しいところ、目にとめていただきありがとうございました。
おかげさまで解決できそうです。
どうもありがとうございました。

回答No.3

imogasi

表題の
>FileSearchが使えなくなり困ってます
と在りますが、FileSearchは
http://officetanaka.net/excel/vba/tips/tips36.htm
のようなのを連想しました。しかし質問のコードには＞ Application.FileSearchなどは出てきていません。表題が適当でないのでは。術語であるものを、内容的に似ていることに使うことは慎重にすべきと思います。「ファイルがフォルダ内にあるかさがす」などとすべきです。
ーー
ファイルをファルダ内から探すコードは
（１）Dir
（２）FSO（For Each　In ObjFolder.Files法とFileSearch法の２方法）
の２つの方法があり、
また
（１）セルの値をずらしてその値でファイルを探すループと
（２）Dirでファイルを探すループと
２つあるわけで（質問の場合は（１）が外側ループか？と思う）
２つは入れ子の関係にすれば良いと思う。
ーーー
Googleででも「フォルダ内　ファイル　VBA」で照会すれば、沢山記事やコードがある。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html以下多数。
情報はあふれていて、ほとんど、ここに質問を繰り返す課題では無い状態と思う。

お礼

早々の回答ありがとうございました。
表題・文面の誤りで分かりにくい質問になりましたこと大変失礼致しました。
指摘していただいたとおりです。
ｉｍｏｇａｓｉさんだけでなく他の方でも不快に思われた方きっとたくさんいらっしゃいますね？お詫び申し上げます。

そして親切な説明大変感謝致します。
ただし、インターネットでの照会は沢山記事は確認しておりまして、紹介していただいたサイトもすでにどちらもみておりますが、それでも解決できなかったので、今回このサイトの相談箱を使用させていただきました。
申し訳ございません。
「出来る大辞典 ExcelVBA」の本もみて、手直ししてるのですが、うまくいきません。
理解がどうしても出来ず、自分で直すことができないので良い方法があれば手直ししていただくと大変助かります。

よろしくお願い致します。

回答No.2

Wendy02

こんにちは。

前回の質問にも回答をつけておきました。
>For Each p In Selection

基本的に、これは何ですか？ Selection というと、ファイル名をユーザー選択させるのですか？
Loop というのも良く分かりません。複数選択して開くのですか？

それなら、
Set book = Workbooks.Open(mypath & p)
これは、オブジェクトを確保するのは無駄でしょうね。

Workbooks.Open　mypath & p
だけでよいです。

複数選択なら、このメッセージも不要です。
MsgBox ("検索結果：該当なし")

しかし、元のコードで開けられないということではありません。
もっと基本的なコードから広げていくべきだと思います。いきなり、ループでは分からないです。

まず、以下のような基本コードで開けるのか、ということです。
-------------------------------------------
Sub TestMacro()
　　Dim mypath As String
　　Dim p As Variant
　　mypath = "C:\保存先\" 'Application.DefaultFilePath & "\"
　　p = "Test1.xls"
　　If Dir(mypath & p) <> "" Then
　　　　Workbooks.Open mypath & p
　　Else
　　　　MsgBox mypath & p & "は見つかりません。"
　　End If
End Sub

補足

Wendy02さん　度々の回答ありがとうございました。
素人でとんちんかんな質問ばかりしてしまい申し訳ございません、
回答大変感謝致します。

>For Each p In Selection
基本的に、これは何ですか？ Selection というと、ファイル名をユーザー選択させるのですか？
Loop というのも良く分かりません。複数選択して開くのですか？
↑ですが、何かと聞かれると？・・・申し訳ございませんまったく理解できておりません。自らコード作成が困難にな為なるべく前任者の方のを引用したものです。不要でしたか？

＞複数選択して開くのですか？
↑複数選択は致しません。セルを選択したら毎度実行致します。
基本コードをコピーさせていただいたところ、
指定の保存先にいれた“Test1.xls”の保存名のものを開くことが出来ました。

選択したセル値がｐの場合を開くにはどこに付け加えればよろしいでしょうか？
それと、拡張子“xlsm”も同じファイル先に保存された場合も開くことは可能でしょうか？

すがるような質問ばかりで申し訳ございません。
よろしくお願い致します。

回答No.1

hige_082

'データがなければ抜ける。
If p = "" Then
Exit Sub
else
p = p & ".xls"
End If

これでうまく行きませんか？

補足

hige_082さん　度々のアドバイスありがとうございます。
開けました（泣）！

もう2点質問させてください。
アドバイスいただいた形ですと元の値に“.ｘｌｓ”が付く形になりましたが、元の値はそのままにしておきたい場合はどのようにすればよろしいでしょうか？
それと、“.xlsm”も“.xls”と混ざって保存されてる場合にどっちの拡張子も開くにはどのようにすればよろしいでしょうか？

質問ばかりで申し訳ございません。
どうぞよろしくお願い致します。