[VBA]ファイル名の末尾にA～Zを付けて検索したい

いつもお世話になってます。

工場の現場のタブレットPCから
NASの中にある図面(PDF)を見つけ出して
タブレットの画面に表示するというマクロを使っております。
※ユーザーフォームの画面、コードは最下段の通りです

このマクロは、こちらのサイトで頂いた、
マクロに対して、私がユーザーフォームを作成し、
ボタンを割り当てただけのものです。

作成時にアドバイスして下さった、
みなさんありがとうございました。
↓
http://bit.ly/2awqTb2
http://bit.ly/29gdmC4　

このマクロを使っていたのですが、
最近になって問題が出てきました。

それは図面の改正です。

図面の改正にはルールがあり、
改正された時には末尾(一番右)にA～Z(半角大文字)が
付与されます。

要するに、以下のような感じになります。

1A000123 図番(初版)
↓改正
1A000123A 図番＋A(改正コード)

というようになります。

今まではユーザーフォームのボタンにある通り、
配布された図番だけで見つからなかった場合、

図番に対して改正コードの「A」、「B」を付与して
再度検索すれば大抵の場合、見つかりました。

ところが最近になって、
配布した時は初版(改正コードなし)なのに、
現場が使うより早く「C」以降の改正コードがついたり、

既に改正がかかった状態で配布された図面番号「2A000123A」が
「2A000123G」になったりするようなケースが増えました。

そのため、現場の作業者が以下のMacro1で検索しても見つからなくなり、
以下の2点について対応しなけらばならなくなりました。
-------
A)図番(初版)に対してA～Zまでの改正コードを付与して再検索する

B)図番＋改正コードの図面番号に対して、改正コードをB～Zに変更し
再度検索する
-------
ということが必要になりました。

すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
お手数ですがA)、B)について教えて下さい。よろしくお願いします。

注意
１）便宜上、ファイルはCドライブの「A」フォルダーに
入っていることにしてます。コードを書く時はこれでお願いします。
※フルパスは「C:\A」です。
※NASへのパスはこちらで書き換えます。

２）画像のユーザーフォーム上の数字はボタンの番号です

３）一番上のテキストボックスに図面番号をバーコードリーダーで入力しています。
※手入力も可能です
※下のテキストボックスはフルパスを表示しています。管理上便利なので表示しています。

追記
余裕があればコードを書く時に以下の1)、2)のことを
考慮して書いて頂けるとありがたいです。
※余裕がなければ書きやすいように書いて頂いて大丈夫です。

1）変数を使う時は変数を宣言しない
2）変数の名前は日本語(漢字かひらかな)で名前をつける
↓
VBA初心者です。頂いたコードをカスタマイズする時に便利ですので
1)、2)について配慮して頂けるとありがたいです。
不可なら書きやすいように書いて頂いてOKです

3)以下のMacro1が現状のマクロです。
今のこちらの実力を知って頂くために記載しました。
こちらをカスタマイズしてもいいし、全部自分で作ったものでもOKです。
※エラー対策＝ファイルがないときのメッセージ表示はつけて下さい

すいませんがよろしくお願いします。

------標準モジュール-------------

Sub Macro1()
UserForm1.Show vbModeless
End Sub

------ユーザーフォーム-------------
Private Sub CommandButton1_Click()

TextBox2.Value = "C:\A" & "\" & TextBox1.Value & ".pdf"

End Sub

Private Sub CommandButton2_Click()
TextBox1.Value = ""
TextBox2.Value = ""
TextBox1.SetFocus

End Sub

Private Sub CommandButton3_Click()

Dim WSH As Object
Dim FName As String
Set WSH = CreateObject("Wscript.Shell")
FName = TextBox2.Value
If Dir(FName, vbNormal) = "" Then
MsgBox "ファイルが見つかりません。", vbExclamation
Else
WSH.Run """" & FName & """", 3

Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With

End If

Set WSH = Nothing

End Sub

Private Sub CommandButton4_Click()

TextBox2.Value = ""
TextBox2.Value = "C:\A" & "\" & TextBox1.Value & "A" & ".pdf"

End Sub

Private Sub CommandButton5_Click()
TextBox2.Value = ""
End Sub

Private Sub CommandButton6_Click()

TextBox2.Value = ""
TextBox2.Value = "C:\A" & "\" & TextBox1.Value & "B" & ".pdf"

End Sub

No.3 ベストアンサー 回答者： ki-aaa 回答日時： 2016/08/19 14:15

返礼、ありがとうございます。

>１）番号を入力するテキストボックスは「TextBox2」で良いのでしょうか？
「TextBox1」なのでしょうか？

「TextBox1」に、入力してください。

>２）ボタンは「CommandButton3」しかありませんが、
「CommandButton3」のボタンだけで検索に行くのでしょうか？

「CommandButton3」だけで、検索するように、書き換えます。
また、「TextBox1」に入力した番号に、123456A,B...Gなどが
有っても良いようにしました。


Private Sub CommandButton3_Click()
Dim WSH As Object
Dim FName As String
Dim 前側FName As String
Dim i As Long

　
If TextBox1.Value = "" Then Exit Sub
TextBox2.Value = "C:\A" & "\" & TextBox1.Value & ".pdf"
Set WSH = CreateObject("Wscript.Shell")
FName = TextBox2.Value
i = InStrRev(FName, ".")
If Mid(FName, i - 1, 1) Like "[A-Z]" Then
前側FName = Left(FName, i - 2)
Else
前側FName = Left(FName, i - 1)
End If



If Dir(FName, vbNormal) = "" Then
For i = 65 To 90
If Dir(前側FName & Chr(i) & ".pdf", vbNormal) <> "" Then
'Chr(65)...A, Chr(66)...B, Chr(90)...Z
FName = 前側FName & Chr(i) & ".pdf"
Exit For
End If
Next i
If i > 90 Then 'for...nextで見つからなかった時にiは91
MsgBox "ファイルが見つかりません。", vbExclamation
Set WSH = Nothing
Exit Sub
End If
TextBox2.Value = FName
End If


WSH.Run """" & FName & """", 3

Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With

Set WSH = Nothing
End Sub

この回答へのお礼

別途、コードを書き換えて頂きありがとうございます。
ボタン1発でパターンA)とB)の両方に対応しているので、びっくりしました。
非常に苦労していろいろ考えていたので助かりました。

説明が長く、複雑な質問に丁寧に答えて頂き本当にありがとうございます。
機会がありましたら、またお願いします。
今回は解答して頂きありがとうございました。

※ベストアンサーですが他の方のアドバイスがあるかもしれないので、
しばらく質問は開けておきます。

お礼日時：2016/08/19 17:34

No.4 回答者： ママチャリ 回答日時： 2016/08/20 11:18

>しばらく質問は開けておきます。

と云うことなので、ちょっとだけ回答させていただきます。
フォルダ内のファイル名が、「図番」もしくは「図番＋改正コード」でユニークになっているのであれば、こんな感じでいけると思います。
ZZ-TOPさんの書いたコードをベースにしているので、読んでいただければ理解できると思いますが、念のため、変更点だけ仕様を書いておきます。

【仕様】
テキストボックス１に入力されているファイル名に、”？”（任意の1文字を表すワイルドカード）を付加して、実際に存在しているファイル名を求める。
ファイルが存在していない場合、その旨メッセージを表示して終了。
存在していれば、その名前をテキストボックス２へ転記。以降は、ZZ-TOPさんの書いたコードと同じです。

Private Sub CommandButton3_Click()
Dim WSH As Object
Dim FName As String
Set WSH = CreateObject("Wscript.Shell")
FName = Dir("C:\A" & "\" & TextBox1.Value & "?.pdf", vbNormal)
If FName = "" Then
MsgBox "ファイルが見つかりません。", vbExclamation
Else
FName = "C:\A" & "\" & FName
TextBox2.Value = FName
WSH.Run """" & FName & """", 3
Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With
End If
Set WSH = Nothing
End Sub

この回答へのお礼

ご解答ありがとうございます。

試してみましたがバッチリです！

しかもTextBox2の表示があるので、
エラーの時、どこにアクセスに行ったのかわかるので、
メッチャ良いです。

今のところ知識不足で「これ何？」みたいな部分も
多いのですが、元のコードを流用して頂いているので、
大体の動作がわかるので、すごくためになりました。

こちらのサイトで、お世話になることが多いのですが、
ママチャリさんを始め、こちらの質問をよく読んで
質問の意味を理解して、ご解答して頂いている方には
本当に感謝しております。

今回は早くに、ご解答頂きコードの書き換えまで対処して頂いた
ki-aaaさんにベストアンサーをゆずりますが、
ご解答頂き、本当にありがとうございます。

機会がありましたら、またお願いします。

お礼日時：2016/08/20 23:40

No.2 回答者： ki-aaa 回答日時： 2016/08/19 10:21

こんにちわ

>1）変数を使う時は変数を宣言しない
このような条件でコードを書いたことがないのでスルーします。


Private Sub CommandButton3_Click()
Dim WSH As Object
Dim FName As String
Dim 前側FName As String
Dim i As Long


Set WSH = CreateObject("Wscript.Shell")
FName = TextBox2.Value
前側FName = Replace(FName, ".pdf", "")


If Dir(FName, vbNormal) = "" Then
For i = 65 To 90
If Dir(前側FName & Chr(i) & ".pdf", vbNormal) <> "" Then
'Chr(65)...A, Chr(66)...B, Chr(90)...Z
FName = 前側FName & Chr(i) & ".pdf"
Exit For
End If
Next i
If i > 90 Then 'for...nextで見つからなかった時にiは91
MsgBox "ファイルが見つかりません。", vbExclamation
Set WSH = Nothing
Exit Sub
End If
TextBox2.Value = FName
End If


WSH.Run """" & FName & """", 3

Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With

Set WSH = Nothing
End Sub

この回答へのお礼

ご解答ありがとうございます。

頂いたコードについて以下の３点について教えて下さい。

１）番号を入力するテキストボックスは「TextBox2」で良いのでしょうか？
「TextBox1」なのでしょうか？

２）ボタンは「CommandButton3」しかありませんが、
「CommandButton3」のボタンだけで検索に行くのでしょうか？

※こちらのMacro1では
①「下の窓へ」で一度、下のテキストボックス(TextBox2)にフルパスが記載されます。
そのあとで、③の検索ボタンを押して検索を実行してますので、
一応、他にボタンがないか確認させて下さい。

３）HDDがC:とD:の２台あります。
テキストボックスを空白にして検索をかけるとエクスプローラーの
「コンピュータ」の画面で止まります。
※エラーメッセージが出ません

すいませんが以上の３点について教えて下さい。
※こちらの知識不足で説明して頂いてもわからない場合があります。

ストレスにならない範囲で答えて頂ければOKです。

今回はご解答頂きありがとうございます。
せっかく教えて頂いたのですが、わからないかもしれませんが、
VBAの勉強中なので勉強のヒントになればそれでいいです。

今回はご解答頂きありがとうございます。

お礼日時：2016/08/19 11:50

No.1 回答者： みっさん 回答日時： 2016/08/19 09:29

ややこしく複雑な事をするのですね。

文書・データーが更新されたら、(_A)と言う様に「アンダーバーを付けて通し記号」を付けます。
＊ファイル名の後に(1)・・(5)とかでも可能です。
同じファイルはディレクトリで整理です。
データーを更新したら、(_？)を大きくしていきます。
このような状態で、マクロ？を使った事はありません。
データー名の見本を添付しました。
＊＊意図が違っていたらごめんなさい。

この回答へのお礼

ご解答ありがとうございます。

>ややこしく複雑な事をするのですね。

ごもっともだと思います。
なので、簡単に説明しますね。

１）本当はフォルダーが深い
※図面番号の上２ケタ～４ケタでフォルダーが作成されています。
なので、本当はサブフォルダーから検索する必要があります。
※サブフォルダーを指定するマクロはこちらで作成してます。

２）大量に図面がある
１）で説明したとおりサブフォルダーだけで100個以上あります。
その中に数千枚の図面があります。しかも不定期に数枚単位で改正がかかります。
※改正コードは得意先が決めるので、こちらでは勝手なコードを付与することができません。

３）「工場の現場のタブレットPCから～」ということで、
タブレットの使用者は工場の作業者なので、手袋を着用しております。

そのため、こちらでユーザーフォームを作成し、
ボタンを押しやすいインターフェイスを用意しております。
通常のようにキーボード(ソフトウエア)やマウスからの操作はできません。

という事情です。

リンク先の
http://bit.ly/2awqTb2
http://bit.ly/29gdmC4　

を閲覧して頂ければ幸いです。

今回はご解答頂きありがとうございます。
良い方法、アドバイスがございましたらまたお願い致します。

お礼日時：2016/08/19 09:52