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

下記のマクロは先日教えて頂いたマクロで、マクロを実行すると
同じ作業フォルダ内にある別ブック（拡張子が.xlsx）を開きコピー範囲を指定出来るようになっております。
稀に、（拡張子が.xlsm）の場合もあり、拡張子が（.xlsx又は.xlsm）の両方に対応できるように変更出来る方法があれば教えてください。
尚、フォルダ内には、作業ブック（マクロ設定ブック）とコピー元のExcelファイル2つしかありません。
よろしくお願いいたします。
現状のマクロ
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
よろしくお願いいたします。

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

• 

  回答ありがとうございます。
  拡張子は（.xlsx）と(.xlsm)だけに限定でお願いいたします。
  よろしくお願いいたします。

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

No.3 回答者： tatsumaru77 回答日時： 2024/07/04 11:32

No2です。

>拡張子は（.xlsx）と(.xlsm)だけに限定でお願いいたします。
了解しました。
拡張子（.xlsm）を含めると、自分自身のファイル名（マクロを格納したファイル）も取得してしまうので、これは、除く必要があります。
又、Dir関数で拡張子を(.xlsmと.xlsx)だけに限定して指定することはできないので、(.xls?)にして取得します。（?は任意の1文字）
したがって、余分な拡張子のものも取得する可能性があるので（例えば.xlsd等）、拡張子が（.xlsmと.xlsx）だけを取得対象ファイルとしてオープンするようにします。
以下のようにしてください。

Sub 提出シートコピー範囲()
Dim folderPath As String
Dim fileName As String
Dim ws As Worksheet
folderPath = ThisWorkbook.Path & "\"
'作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の
'○〇(提出用).xlsxの 2つ のExcelファイルしかありません｡
fileName = Dir(folderPath & "*.xls?")
Do While fileName <> ""
If CheckName(fileName) = True Then Exit Do
fileName = Dir()
Loop
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
Private Function CheckName(ByVal fileName As String) As Boolean
CheckName = False
If fileName = ThisWorkbook.Name Then Exit Function
CheckName = True
If LCase(Right(fileName, 5)) = ".xlsx" Then Exit Function
If LCase(Right(fileName, 5)) = ".xlsm" Then Exit Function
CheckName = False
End Function

この回答へのお礼

ご連絡ありがとうございました。
全て上手く行きました。
感謝いたします。

お礼日時：2024/07/04 11:52

No.2 回答者： tatsumaru77 回答日時： 2024/07/04 11:05

念のため、確認ですが、今後、拡張子が、(.xls)とか(.xlsb)とかも含めたいということはないのでしょうか。

拡張子は（.xlsx）と(.xlsm)だけに限定して良いのでしょうか。
特に、(.xls)は古い形式のexcelファイルですが、これを使用する方が、たまに見受けられます。

下記が、excelでサポートしているファイルの拡張子の一覧です。
https://support.microsoft.com/ja-jp/office/excel …

No.1 回答者： Qchan1962 回答日時： 2024/07/04 09:01

その場しのぎですが

fileName = Dir(folderPath & "*.xlsx")
fileName = Dir(folderPath & "*(提出用)*.xls*")

そのままにしてしまいましたが古いSub 提出シートコピー範囲()を使う可能性を考慮して名前を変えた方が良いかと

この回答へのお礼

何時も回答をありがとうございます。
別マクロで作成作成させていただきました。
ありがとうございます。

お礼日時：2024/07/04 09:30