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

Question

下記のマクロは先日教えて頂いたマクロで、マクロを実行すると、ワイルドカードで指定したブックを開く事が出来ます。ファイル名 ①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 以上となります。よろしくお願いいたします。

tatsumaru77 · Accepted Answer

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

Qchan1962 · Answer

>.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

tatsumaru77 · Answer

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

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

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

Qchan1962 · Answer

＃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　と　拡張子で判断できるので(提出用)は不要になります

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

Qchan1962 · Answer

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

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

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

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

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

tatsumaru77 · Answer

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

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

little_experience000 · Answer

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

では

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

No5です。

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

No2です。

＃3です

こんにちは

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

Sub 提出シートを開く()

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング