[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ワイルドカードでファイルを開きたい』（モンハン）
下記のVBAで、指定フォルダにある毎回ファイル名がチャート_G2(202310以降変わるので
ワイルドカードを使用して以下の通り記述してみましたが、エラーとなります。
どの様にしたらいいでしょうか？
Sub データを抽出()
Application.ScreenUpdating = False
Application.DisplayAlerts = False '確認メッセージを表示しない設定
Worksheets("チャート_G2(202310*.csv").Delete
Application.DisplayAlerts = True '確認メッセージを表示する設定
'toWBには貼り付け先ブック、frWBにはコピー元ブックを代入する
Dim toWB As Workbook, frWB As Workbook
'変数wbPathにはブックの保存場所のパスを代入する
Dim wbPath As String
wbPath = ThisWorkbook.Path
'貼り付け先のブックを取得する
Set toWB = Workbooks.Open(wbPath & "\チャート記録.xlsm")
'コピー元のブックを取得する
Set frWB = Workbooks.Open(wbPath & "\チャート_G2(202310*.csv") 'C:\Users\user\Documents
'コピー元（frWB）の先頭シートを貼り付け先（toWB）の先頭にコピーする
frWB.Worksheets(1).Copy Before:=toWB.Worksheets(2)
'コピー元ブックを閉じる
frWB.Close
Set toWB = Nothing: Set frWB = Nothing
Application.ScreenUpdating = True
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
ワイルドカード文字(*) はシート名には使えません。 またブック名にも使えません。 Dir関数を使って、具体的な名称を確定させたうえで、それを開く必要があります。 （xyz） 2023/11/01(水) 23:01:19
動作確認していませんが
Sub データを抽出()
Application.ScreenUpdating = False
Application.DisplayAlerts = False '確認メッセージを表示しない設定
On Error Resume Next
Worksheets("チャート_G2").Delete
On Error GoTo 0
Application.DisplayAlerts = True '確認メッセージを表示する設定
'toWBには貼り付け先ブック、frWBにはコピー元ブックを代入する
Dim toWB As Workbook, frWB As Workbook
'変数wbPathにはブックの保存場所のパスを代入する
Dim wbPath As String
wbPath = ThisWorkbook.Path
'貼り付け先のブックを取得する
Set toWB = Workbooks.Open(wbPath & "\チャート記録.xlsm")
'コピー元のブックを取得する
csvName = Dir(wbPath & "\チャート_G2(202310*.csv")
Set frWB = Workbooks.Open(wbPath & "\" & csvName)
'コピー元（frWB）の先頭シートを貼り付け先（toWB）の先頭にコピーする
frWB.Worksheets(1).Move before:=toWB.Worksheets(2)
ActiveSheet.Name = "チャート_G2"
Set toWB = Nothing: Set frWB = Nothing
Application.ScreenUpdating = True
End Sub （マナ） 2023/11/01(水) 23:02:45
Dim csvName as String を追加 （マナ） 2023/11/02(木) 12:53:28
csvName = Dir(wbPath & "\チャート_G2(202310*.csv")
Set frWB = Workbooks.Open(wbPath & "\" & csvName)
上記のファイルが一階層下にある場合はどうしたら取得出来ますか？
教えて下さい
（モンハン） 2023/11/08(水) 18:30:27
csvPath = wbPath & "\対象フォルダ名"
csvName = Dir(csvPath & "\チャート_G2(202310*.csv")
Set frWB = Workbooks.Open(csvPath & "\" & csvName)
（マナ） 2023/11/09(木) 08:40:51
'貼り付け先のブックを取得する
Set toWB = Workbooks.Open(wbPath & "\チャート記録.xlsm")
上記のファイル名を「チャート記録1」とかに変更しても対応出来る様にしたいのですが
教えて下さい。
（モンハン） 2023/11/15(水) 21:04:52
Dim wbName as string
wbName = Dir(wbPath & "\チャート記録*.xlsm")
Set toWB = Workbooks.Open(wbPath & "\" & wbName)
（マナ） 2023/11/15(水) 21:19:28
後出しで申し訳ございません。
チャート記録の後がファイル名が変更になればこれで可能ですが
チャート記録を全て変更になった場合、例えば「設備管理」などとかに変更の場合はどうしたらいいでしょうか？
教えて下さい。
（モンハン） 2023/11/15(水) 21:31:26
こことかを参考にする https://excel-ubara.com/excelvba1/EXCELVBA374.html （マナ） 2023/11/15(水) 21:52:02
現在のコードを提示して下さい。 マナさんが2023/11/15(水) 21:52:02に提示された方法ならば、 あるものだけを選択するはずですが。 それとは別の話なら、他人にわかるように質問して下さい。 まあ普通には、Dir関数の戻り値が<>""のものだけ対象にすればいいわけですが。 （xyz） 2023/12/14(木) 13:17:30
'コピー元の1階層下のブックを取得する
Dim csvName As String
csvPath = wbPath & "\チャート紙T"
csvName = Dir(csvPath & "\T-2_G1(202*.csv")
Set frWB = Workbooks.Open(csvPath & "\" & csvName)
'コピー元（frWB）の先頭シートを貼り付け先（toWB）の先頭にコピーする
frWB.Worksheets(1).Move before:=toWB.Worksheets(2)
ActiveSheet.Name = "チャート_T"
（モンハン） 2023/12/14(木) 22:14:22
If csvName <> "" Then
''開いてコピーする部分をここに。
End If
です。
（xyz） 2023/12/15(金) 09:52:24
Dim csvName As String
csvPath = wbPath & "\チャート紙T"
csvName = Dir(csvPath & "\T-2_G1(202*.csv")
If csvName <> "" Then
End If
Set frWB = Workbooks.Open(csvPath & "\" & csvName)
'コピー元（frWB）の先頭シートを貼り付け先（toWB）の先頭にコピーする
frWB.Worksheets(1).Move before:=toWB.Worksheets(2)
ActiveSheet.Name = "チャート_T"
Set frWB = Workbooks.Open(csvPath & "\" & csvName)でエラーがでます。
挿入先が間違ってるでしょうか？
（モンハン） 2023/12/16(土) 14:47:03
> If csvName <> "" Then > ''開いてコピーする部分をここに。 > End If （マナ） 2023/12/17(日) 21:21:01
今度は実行時エラー91が下記のコードのところで発生します。
frWB.Worksheets(1).Move before:=toWB.Worksheets(2) （モンハン） 2023/12/19(火) 00:20:37
■１
なんでもかんでも聞いて終わりにするんじゃなくて、研究してちゃんと理解されたほうがよいとおもいます。
■２
また、提示するならばSub～End Subまでが、１つのプロシージャという塊ですから、部分的に抜粋するのではなく全部提示されたほうがよいでしょう。
(提示する必要があるかどうか判断できないならなおさらです）
■３
今回の処理では、自ブック（マクロブック）、挿入先ブック、挿入したいシートがあるブック（実際はcsvファイル）の【３つ】がありますから、処理の順番としては
(1)（自ブックと同じフォルダにある）挿入先のブックを開く (2)（自ブックが保存されているフォルダの配下にあるフォルダに該当ファイルがあるかチェックしてから、あれば）csvをブックとして開く (3)(2)を(1)に【コピー挿入する】 (4)(2)を（保存せずに）閉じる
という感じで考えればよいでしょう。コードにするとこんな感じです。
Sub 研究用()
Dim toWB As Workbook
Dim フォルダパス As String
Dim ファイル名 As String
Set toWB = Workbooks.Open(ThisWorkbook.Path & "\チャート記録.xlsm")
フォルダパス = ThisWorkbook.Path & "\対象フォルダ名"
ファイル名 = Dir(フォルダパス & "\" & "T-2_G1(202*.csv") '動作はするだろうが閉じ括弧がないのがちょっと気になる
If ファイル名 <> "" Then
With Workbooks.Open(フォルダパス & "\" & ファイル名)
.Worksheets(1).Copy after:=toWB.Worksheets(1)
.Close False
End With
End If
End Sub
※説明のための提示であり、完成品プレゼントの意図はありません。 採用される場合はステップ実行等により研究の上、必要な部分のみご自身のコードに組み込んでください。
（もこな２ ） 2023/12/19(火) 13:15:33
（モンハン） 2023/12/20(水) 19:44:56
追加の質問？については、さすがにどの部分で「挿入先となるブックのパス」を指定してるのかはわかるとおもいますから、その部分を
・特定のフォルダにあるファイルを対象にする ・ダイアログを出してユーザーに選択してもらう
などのアプローチに変えればよいでしょう。
前者は既にこのトピックで出てきていますし、後者は「vba ファイル選択ダイアログ」などのキーワードで検索するとたくさんヒットすると思います。
それでも詰まったら、××と理解して～～～というコードを作成したけど、○○になるはずが△△となってしまうというように具体的な問題を挙げて質問されるとよいように思います。
（もこな２ ） 2023/12/20(水) 20:56:58
もこな２様のコードを参考にして思っていた通りの事が出来ました。 ありがとうございます。ですがファイル名を「チャート記録1」とかに変更しても対応出来る様にしたいのです。自分でやってみたのですが、エラーとなり無理そうです。
Sub 研究用()
Application.ScreenUpdating = False
Application.DisplayAlerts = False '確認メッセージを表示しない設定
On Error Resume Next
Worksheets("チャート_AG").Delete
On Error GoTo 0
Application.DisplayAlerts = True '確認メッセージを表示する設定
Dim toWB As Workbook
Dim フォルダパス As String
Dim ファイル名 As String
Set toWB = Workbooks.Open(ThisWorkbook.Path & "\チャート記録.xlsm")
フォルダパス = ThisWorkbook.Path & "\チャート紙AG"
ファイル名 = Dir(フォルダパス & "\" & "T-2_G1(202*.csv")
If ファイル名 <> "" Then
With Workbooks.Open(フォルダパス & "\" & ファイル名)
.Worksheets(1).Copy after:=toWB.Worksheets(1)
ActiveSheet.Name = "チャート_AG"
.Close False
End With
End If
End Sub
（モンハン） 2023/12/22(金) 22:09:24
Workbooks.Open(ThisWorkbook.Path & "\チャート記録.xlsm")
~~~~~~~~~~~~↑~~~~~~~~~~~~~~~~~~~~~~~~~~
特定のフォルダにあるファイルをワイルドカードをつかって特定する
ダイアログを表示してユーザーに指定してもらう
（もこな２ ） 2023/12/22(金) 22:47:39
上記のコードで試したのですがエラーとなりました
（モンハン） 2023/12/23(土) 12:51:56
（モンハン） 2023/12/23(土) 17:50:19
(でないと、投稿時に間違ったのか本当にミスしているのかわからないので）
踏まえて、「2023/12/23(土) 12:51:56」に提示されたコードを整理すると↓のようになります。
Sub 整理()
Dim toWB As Workbook
Dim フォルダパス As String
Dim ファイル名 As String
Dim wbName As String
Dim wbPath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("チャート_AG").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'▼ 【wbPath】が空っぽ("")のまま
wbName = Dir(wbPath & "\チャート記録*.xlsm")
Set toWB = Workbooks.Open(wbPath & "\" & wbName)
フォルダパス = ThisWorkbook.Path & "\チャート紙AG"
ファイル名 = Dir(フォルダパス & "\T-2_G1(202*.csv")
If ファイル名 <> "" Then
With Workbooks.Open(フォルダパス & "\" & ファイル名)
Worksheets(1).Copy after:=toWB.Worksheets(1)
oWB.Worksheets(1).Next.Name = "チャートAG" '★変更
.Close False
End With
End If
End Sub
＞wbPath=ThisWorkbook.Pathを追加したら動く様になりました。
↑とのことですが、上記で書いたように【wbPath】が空っぽ("")のままだったのが原因です。
■７
＞チャート紙AGフォルダにファイルが無い場合エラーとなりませんが
＞チャート_AGのシートが削除されたままとなります。残す事は可能でしょうか？
そもそも処理順がおかしいです。順番とすれば
(1)挿入先のブックが存在するか調べる (2)↑があれば開き、なければ処理中止
(3)コピー元のブック（CSVファイル）が存在するか調べる (4)↑があれば（ブックとして）開き、なければ処理終了
(5)挿入先のブックに【チャート_AG】シートがあれば削除する
であって、最初にActiveWorkbookの【チャート_AG】シートを削除するようになっているのが不適切でしょう。
（もこな２） 2023/12/24(日) 09:35:53
指摘していない部分も含めて、気になるところがいくつかあります。
（もこな２ ） 2023/12/26(火) 08:36:39
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.