エクセルのマクロについて教えてください。

下記のマクロは先日教えて頂いたマクロで、
マクロを実行すると、ワイルドカードで指定したブックを開く事が出来ます。
ファイル名
①22069167-1_00－確認申請受付【花子】(提出用).xlsx
の場合は上手くマクロが実行されてブックを開く事が出来ますが。
②210610132-1_東二条7丁目住宅新築工事【太郎】(提出用) .xlsx
の場合は"コピー元ブックが見つかりません"を表示されてブックを開く事が出来ません。
下記のコードを変更し、①の場合も②の場合も両方ブックを開く事が出来る方法があれば教えてください。
よろしくお願いいたします。
現状のマクロ
Sub 提出シートを開く()
Dim folderPath As String
Dim fileName As String
folderPath = ThisWorkbook.Path & "\"
fileName = Dir(folderPath & "*(提出用).xlsx")
Do While fileName <> ""
Workbooks.Open (folderPath & fileName)
fileName = Dir()
Loop
End Sub

Sub 提出シートコピー範囲()
Dim ws As Worksheet
If Workbooks.Count > 1 Then
Set Wb2 = Workbooks(2) '別ブック
On Error Resume Next
Set ws = Wb2.Worksheets("提出シート")
If Err.Number <> 0 Then
MsgBox "コピー元ブックの提出シートが見つかりません"
On Error GoTo 0
Wb2.Close False
End
End If
'セルの値を取得する
ws.Range("B1:H47").Copy
Else
MsgBox "コピー元ブックが見つかりません": End
End If
End Sub

以上となります。
よろしくお願いいたします。

質問者からの補足コメント

• 

  №2さん
  大変失礼いたしました。
  №3さんのご指摘で、誤ったお礼をしておりました、
  私としては、今回のケースを含めて、様々なブック名に対応できるようにしたいと思っております。
  よろしくお願いいたします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2024/07/03 12:06

• 

  色々と考えて頂きまして、ありがとうございます。
  作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の
  ○〇(提出用).xlsxの2つのExcelファイルしかありません。
  提案していただけた
  folderPathには自ブックと絶対にターゲットブックしかないという事であれば　Do While　と　拡張子で判断できるので(提出用)は不要になります
  を使用した、コードを教えていただけますか。
  申し訳ありません。
  よろしくお願いいたします。

  No.4の回答に寄せられた補足コメントです。 補足日時：2024/07/03 12:11

• 

  ご連絡ありがとうございます。
  現状では（提出用）をワイルドカードにて判断しておりますが、
  出来れば、作業フォルダ内にはマクロ設定ブックと〇〇(提出用).xlsxの2つしかExcelファイルはありません。
  ターゲットブックしかないので、拡張子で判断し、(提出用)は不要になればと思っております。
  よろしくお願いいたします。

  No.5の回答に寄せられた補足コメントです。 補足日時：2024/07/03 12:36

No.7 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/07/03 12:48

No5です。

＞出来れば、作業フォルダ内にはマクロ設定ブックと〇〇(提出用).xlsxの2つしかExcelファイルはありません。
＞ターゲットブックしかないので、拡張子で判断し、(提出用)は不要になればと思っております。

そういうことでしたら、Sub 提出シートを開く()を
以下のように変えれば良いかと。（動作確認はしておりません）

Sub 提出シートを開く()
Dim folderPath As String
Dim fileName As String
folderPath = ThisWorkbook.Path & "\"
fileName = Dir(folderPath & "*.xlsx")
If fileName <> "" Then
Workbooks.Open (folderPath & fileName)
End If
End Sub

この回答へのお礼

ご連絡ありがとうございます。
今回教えて頂いたコードを早速試召させていただきます。

お礼日時：2024/07/03 13:05

No.6 回答者： Qchan1962 回答日時： 2024/07/03 12:34

>.xlsxの2つのExcelファイルしかありません。

このロジックは使いまわすのではないかと思うのですが・・・違ったかな？
いずれにいたしましても　今回の場合（不具合の種をまきたくないので）
Call 提出シートを開く で呼ぶのをやめて
Sub 提出シートコピー範囲()内にまとめるべきです


Sub 提出シートコピー範囲()
Dim folderPath As String
Dim fileName As String
Dim ws As Worksheet
folderPath = ThisWorkbook.Path & "\"
'作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の
'○〇(提出用).xlsxの 2つ のExcelファイルしかありません｡
fileName = Dir(folderPath & "*.xlsx")
If fileName <> "" Then
'別ブック ○〇(提出用).xlsx
Set Wb2 = Workbooks.Open(folderPath & fileName)
On Error Resume Next
Set ws = Wb2.Worksheets("提出シート")
If Err.Number <> 0 Then
MsgBox "コピー元ブックの提出シートが見つかりません"
On Error GoTo 0
Wb2.Close False
End
End If
'セルの値を取得する
ws.Range("B1:H47").Copy
Else
MsgBox "コピー元ブックが見つかりません": End
End If
End Sub

この回答へのお礼

この度も回答と色々、教えて頂きましてありがとうございます。
色々なケースで為させて頂きます。

お礼日時：2024/07/03 13:06

No.5 回答者： tatsumaru77 回答日時： 2024/07/03 12:25

No2です。

>私としては、今回のケースを含めて、様々なブック名に対応できるようにしたいと思っております。

様々なブック名とは、具体的にどのようなケースでしょうか。
①任意の文字＋(提出用).xlsx
②任意の文字＋(提出用) .xlsx
(提出用)の後に半角のスペースが１つある場合
③任意の文字＋(提出用)□□□.xlsx
(提出用)の後に半角のスペースが２つ以上ある場合（□は半角のスペースとします）
④任意の文字＋(提出用)　.xlsx
(提出用)の後に全角のスペースが１つある場合
⑤任意の文字＋(提出用)　　.xlsx
(提出用)の後に全角のスペースが２つ以上ある場合
⑥任意の文字＋(提出用)　　 .xlsx
(提出用)の後に全角と半角が混在しスペースが２つ以上ある場合
⑦任意の文字＋(提出用)XYZ.xlsx
(提出用)のあとに任意の文字（例ではXYZ）があるケース
⑧任意の文字＋（提出用）.xlsx
（提出用）の括弧である（）が全角の場合
⑨任意の文字＋(提出用).xls
拡張子がxlsx以外のブックの場合（xlsm）も含む

①②を正常ケースとして処理したいということは理解できましたが、
③から⑨のケースも正常ケースとして処理されたいのでしょうか？

No.4 回答者： Qchan1962 回答日時： 2024/07/03 11:44

＃3です

名前の付いたExcelが送られて来て　半角スペースが入っている事が避けられないので（*(提出用) .xlsxファイル名で不具合は発生しない）
VBA処理時に　拡張子前の半角スペースを許容したい（今回の文字列）場合は　ワイルドカードを指定するのは危険なので　条件を増やすやり方でどうでしょう

例
Sub 提出シートを開く()
Dim folderPath As String
Dim fileName As String
folderPath = ThisWorkbook.Path & "\"
fileName = Dir(folderPath & "*(提出用).xlsx")
If fileName = "" Then fileName = Dir(folderPath & "*(提出用) .xlsx")
Do While fileName <> ""
Workbooks.Open (folderPath & fileName)
fileName = Dir()
Loop
End Sub
混在する場合は*(提出用).xlsxのみが処理されます

十分に条件を絞れており　Workbooks(2)しか使わないなら
Do While　を使わず　If文で処理した方が良いと思います
Workbooks.Open (folderPath & fileName)　した方が良いと思います

そもそも（絶対と考えてはいけないけれど）
folderPathには自ブックと絶対にターゲットブックしかないという事であれば　Do While　と　拡張子で判断できるので(提出用)は不要になります



だいぶ余計な事かも知れませんが・・
＃２様へのお礼には　語弊があるように思います
内容は＃３で回答した内容と同様に　
問題を危惧して　ご質問の通り進めて良いかを問いかけていると思いますよ

No.3 回答者： Qchan1962 回答日時： 2024/07/03 10:03

こんにちは

原因は
うまくいかないブックには　.xlsxの前に半角スペースがあるからですが
これをVBA側で対応する方法は色々とあります

しかしながら
貴方の処理を期待するブックが複数存在する場合
Do While fileName <> ""
VBA側で条件を広げることは思わぬ不具合を発生させる可能性を考えてください

限定文字　(提出用).xlsx　に不要な文字が入らない対策をするべきだと思います

ブック抽出条件を広げるなら
＃１様の方法や　単純に
fileName = Dir(folderPath & "*(提出用)*.xlsx")
とすればよいですが（知恵でBA）

繰り返し問題を発生させないために
出来ればよいではなく　本質を捉えて　判断してください

この回答へのお礼

回答ありがとうございます。
確認をさせて頂きます。

お礼日時：2024/07/03 10:26

No.2 回答者： tatsumaru77 回答日時： 2024/07/03 10:03

210610132-1_東二条7丁目住宅新築工事【太郎】(提出用) .xlsx

このファイル名は、(提出用)の後に半角の空白が１つあります。
半角の空白を□で表示すると
210610132-1_東二条7丁目住宅新築工事【太郎】(提出用)□.xlsx
のようになっています。
従って、fileName = Dir(folderPath & "*(提出用).xlsx")の行にマッチせず、
このファイルがオープンされません。ファイル名を
210610132-1_東二条7丁目住宅新築工事【太郎】(提出用)□.xlsx
から
210610132-1_東二条7丁目住宅新築工事【太郎】(提出用).xlsx
に変更すれば（半角の空白を削除すれば）、期待した動作になるはずです。

それとも、ファイル名はこのままの状態で、このファイルを開くようにしたいということでしょうか。

この回答へのお礼

回答ありがとうございます。
回答№1と№3の方のを参考にさせて頂きます。

お礼日時：2024/07/03 10:27

No.1 回答者： little_experience000 回答日時： 2024/07/03 09:34

Sub 提出シートを開く()

Dim folderPath As String
Dim fileName As String
folderPath = ThisWorkbook.Path & "\"
fileName = Dir(folderPath & "*(提出用).xlsx")
Do While fileName <> ""
Workbooks.Open (folderPath & fileName)
fileName = Dir()
Loop
End Sub
を
Sub 提出シートを開く()
Dim folderPath As String
Dim fileName As String
folderPath = ThisWorkbook.Path & "\"
fileName = Dir(folderPath & "*.*")
Do While fileName <> ""
if instr(fileName,"(提出用).xlsx")>0 then
Workbooks.Open (folderPath & fileName)
end if
fileName = Dir()
Loop
End Sub

では

この回答へのお礼

回答ありがとうございます。
早速試してみます。

お礼日時：2024/07/03 09:51