特定のフォルダー内のエクセルファイルを開くＶＢＡ

たとえば　C:\My Documents\データ　というフォルダーには２０～３０のエクセルファイルが入っています

ファイルの名前は「えくせる　なんばー１０１」などという名前になっています

「えくせる　なんばー」までは共通で「１０１」の部分はそれぞれランダムな数字が入っています

ランダムなファイル名なのでファイルを捜して開くのが大変です
インプットボックスなどで　「１０１」の部分を入力すれば該当ファイルが開くような　マクロを作りたいのですが

（続きナンバーにして　フォルダの整列をすれば捜しやすいのですが　ネットワーク上の共有フォルダなので勝手にファイル名を変えることが出来ないのです）

ＶＢＡ初心者なのでよろしくお願いします

No.3 回答者： Wendy02 回答日時： 2005/09/03 00:53

こんばんは。

私の考えが間違っていなければ、全面的にやり直さないとダメだと思います。そこで、考え方を換えて作ってみました。

えくせるふぁいる「　　　　」-123.xls
の「　　　　」の中に数字を入れるので、数字だけ聞いてきます。
なければ、先頭文字と、後尾文字

フォルダーの中に、数千もあるようですと、ちょっと厳しいかもしれません。ただ、今の方法が、一番速いというか、だいたい、特殊なファイルサーチプログラムも、このような考えたをしています。

'--------------------
Sub FileOpenSample2()
　 Dim OrgPath As String, Fname As Variant, Fnames() As Variant
　 Dim j As Long, i As Variant, myNo As Variant, flg As Boolean
　 Dim BackF1Name As String
　'======================================================
　'ユーザー設定
　 Const FrontFName As String = "えくせるふぁいる" '"先頭文字
　 Const BackFName As String = "-123.xls" '後尾文字
　 Const myPath As String = "C:\My Documents\" '調べるフォルダ
　'======================================================
　If InStrRev(BackFName, ".XLS", , 1) = 0 Then
　　 BackF1Name = BackFName & ".XLS"
　Else
　　　 BackF1Name = BackFName
　End If
　 OrgPath = ThisWorkbook.Path
　 ChDir myPath
　 Fname = Dir(FrontFName & "*.xls")
　 If Fname = "" Then
　　　MsgBox FrontFName & _
　　　"該当するファイルが見つかりませんので、設定を修正してください。", 64
　　　Exit Sub
　 End If
　 Do
　　　ReDim Preserve Fnames(j)
　　　Fnames(j) = StrConv(Fname, vbUpperCase)
　　　j = j + 1
　　　Fname = Dir
　 Loop Until Fname = ""
　
　 myNo = Application.InputBox(FrontFName & " ???? " & BackF1Name & vbCr & _
　 "番号を入れてください。", Default:=1234, Type:=2)
　 If VarType(myNo) = vbBoolean Or myNo = "" Then
　　　GoTo LineEnd
　 End If
　 '入力されたファイルがあるか調べる
　 For Each i In Fnames
　　　Fname = StrConv(FrontFName & myNo & BackF1Name, vbUpperCase)
　　　If i Like Fname Then
　　　　 flg = True
　　　　 Exit For
　　　End If
　 Next i
　 If flg Then
　　 Workbooks.Open Fname
　 Else
　　'番号で見つからない場合、ファイル・オープンダイアログで、調べる
　　Application.Dialogs(xlDialogOpen).Show (FrontFName & "*" & BackF1Name)
　 End If
LineEnd:
　 ChDir OrgPath
End Sub

この回答へのお礼

ありがとうございます

ちょっと見ただけでは難しそうですね・・・

週末で試すことができないので（家のパソにはOfficeが入っていないのです）

週明けに試してみます

お礼日時：2005/09/03 09:24

No.2 回答者： Wendy02 回答日時： 2005/09/02 16:43

こんにちは。

こんに風に考えてみました。

Option Explicit
Sub FileOpenSample()
　 Dim OrgPath As String, Fname As Variant
　'======================================================
　'ユーザー設定
　 Const BaseFileName As String = "えくせる　なんばー"
　 Const myPath As String = "C:\My Documents\"　　'調べるフォルダ
　'======================================================
　 OrgPath = ThisWorkbook.Path
　 ChDir myPath
　 Fname = Application.InputBox(BaseFileName & "　の次番号を入れてください。", Default:=101, Type:=2)
　 If VarType(Fname) = vbBoolean Or Fname = "" Then
　　　GoTo LineEnd
　 End If
　 '入力されたファイルがあるか調べる
　 If Dir(BaseFileName & Fname & ".xls") <> "" Then
　　　Workbooks.Open BaseFileName & Fname & ".xls"
　　　Else
　　　'ない場合は、オープンダイアログで、調べる
　　　Application.Dialogs(xlDialogOpen).Show (BaseFileName & "*.xls")
　 End If
LineEnd:
　ChDir OrgPath
End Sub

この回答への補足

早速のご回答ありがとうございます

わがままついでにもうひとつ補足させてください

「えくせる　ふぁいる」の後の数字は３桁ではなく「１０１０－１」だったり「１２３４－５６」だったりするのです　本当はもっと複雑なのですが　ハイフォンの前の数字は整数４桁と決まっています

ですが　全部正確に入力するのは大変なので　４桁の数字だけを入力すれば該当するファイルを選び出すということはできないでしょうか

ファイル名が「えくせる　ふぁいる１２３４－５６」の場合は　「１２３４」を入力すれば良い　という風に

うまく説明できなくてすみませんが　お分かりいただけましたでしょうか　よろしくお願いします

補足日時：2005/09/02 20:23

No.1 回答者： mshr1962 回答日時： 2005/09/02 16:26

こんな所でしょうか？ショートカットを設定するか、図形にマクロの登録で設定してください。

Sub NOFILEOPEN_Click()
On Error GoTo NOFILE_Err
Dim FPASS, FNAME, FNO As String
FPASS = "C:\My Documents\データ\"
FNAME = "えくせる　なんばー"
FNO = Format(InputBox("ファイルナンバーを入力"), "000")
Workbooks.Open FPASS & FNAME & FNO
Exit Sub
NOFILE_Err:
X = MsgBox("ファイルが存在しません。", vbOKOnly)
End Sub