
こんにちは。
Dir関数を使用して、マクロ実行用ブックの存在するフォルダ内の他ブック(xls、xlsx)を
1個ずつ開く→内容の一部をコピー→別ブックでcsv保存
という動作をループで行いたいのですが、ひとつのブックが完了した後処理が次のブックへ移らず、最初のブックに対して永遠に同じ処理を繰り返してしまい困っております。
例)
A.xls B.xls C.xlsというブックが存在するフォルダに対し処理を行った時、A.csv、B.csv、C.csvというファイルが生成してほしいのだが、A.csv、A.csv(2)、A.csv(3)……と同じブックのCSVが永遠に生成されてしまう。
各ブック上での処理マクロ自体は動作が完了しており、個別のブックに直接マクロを記述し実行すると問題なくcsvが生成されてくれるのですが、複数ブックに対し…の方がうまくいきません。
解決についてご教授頂ける方、ぜひご回答頂けましたら幸いです。
下記にループ部分のみのコードを記載させて頂きます。(不足があるかもしれないのですが、各ブック用のマクロがかなり長文だったため…)
Sub テスト()
Dim i As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim x As Long
Dim TmpSheet As Worksheet, wc As Integer
Dim wLastGyou As Long
Dim Path As String
Dim myFile As String
Path = ThisWorkbook.Path & "\"
myFile = Dir(Path & "*.xls*")
Do Until myFile = ""
Workbooks.Open Path & myFile
'各ブックでの処理ここから
(※ここでマクロ実行用ブックの存在するフォルダ内のxlsm以外のブック(xls、xlsx)を
1個ずつ開く→内容の一部をコピー→別ブックで保存→元ブックを閉じる
という動作を繰り返します。)
'各ブックでの処理ここまで
' myFile = Dir() '←現在無効にしているこのコードにすると実行時エラー5、プロシージャの呼び出し、または引数が不正です。というエラーになります
Dir (Path & "*.xls") '←こちらのコードにすると同ブック上で永遠にループします
Loop
End Sub
どうぞよろしくお願い致します。
No.3ベストアンサー
- 回答日時:
既に回答が出ていますが、Dirを二重に使用している点が問題なのでしょうね。
単純にファイル名の有無を調べるだけなら、
FileSystemObjectオブジェクト - FileExistsメソッド
http://officetanaka.net/excel/vba/filesystemobje …
こちらを組み込んだ方が宜しいのかもですね。
途中のDirをこちらのコードで書き換えなければならないという事ですね…
代替案までありがとうございます、挑戦してみます!
長らくログインできず、困っておりましたが、問題解決まで気にかけてくださりありがとうございました!
No.2
- 回答日時:
Dir(条件)が重複する場合は、Dir()は使えません。
myFile = Dir()
この意味は「前回行ったDirと同一条件で、該当する別ファイルを探し、ファイルをmyFileに代入」です。
前回行ったDirは、残念ながら上の方にあるmyFile = Dir(Path & "*.xls*")ではなくて、途中にある
fn = Dir(temp & ".csv")
とか
fn = Dir(temp & "(" & Format(ix + 1, "0") & ")" & ".csv")
とか
fn = temp & "(" & Format(ix + 1, "0") & ")" & ".csv"
でしょうから、そこで想定外のファイルを開こうとしておかしくなったのだと思います。
No.1
- 回答日時:
>' myFile = Dir() '←現在無効にしているこのコード
本来はこちらで良いのでしょうけど、気になるのは
>Path = ThisWorkbook.Path & "\"
>myFile = Dir(Path & "*.xls*")
まず自分自身を再度開こうとする事があるのではないか?
開く前に
Do Until myFile = ""
If myFile <> ThisWorkbook.Name Then
Workbooks.Open Path & myFile
'~処理~
End If
myFile = Dir()
Loop
と自分自身を避ける必要の有無についてはこちらでは判断しかねますが、一応回答してみます。
あと本題については開く際のBook名は変数:myFile に格納されているでしょうけど、
>別ブックで保存→元ブックを閉じる
この辺をどうやっているのか?がわかりませんしね。
なので回答は難しいかもですよ。
変数を用いてとか、myFile を加工しているのかなど憶測はたてられそうですが、解決に繋がるとも言えないし。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) フォルダ内の全ブックのシート名を変更したい 7 2022/09/22 21:34
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) マクロVBA 1シートをまとめる 閉じ方 初心者 SOS! 1 2022/06/17 14:54
- その他(Microsoft Office) マクロVBAについて 1 2022/09/06 18:12
- Visual Basic(VBA) VBA This Workbookモジュールを別ファイルにコピーする方法 1 2022/09/14 01:51
- Excel(エクセル) 【VBA】複数ブックから特定のシートを抽出して一つのブックに集約するマクロについて 3 2022/09/04 15:05
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
別ブックをダイアログボックス...
-
VBA 別ブックからコピペしたい...
-
ワイルドカード「*」を使うとう...
-
Excelマクロ 該当する値の行番...
-
エクセル VBA 他シートの行を選...
-
Excelのマクロコードについて教...
-
【ExcelVBA】インデックスが有...
-
vbaでvbaProjectのパスワード解...
-
【Excel VBA】書き込み先ブック...
-
【マクロ】アクティブセルにブ...
-
エクセルVBAが途中で止まります
-
VBAで別ブックのシートを指定し...
-
【前回の続き続きです、ご教示...
-
VBAで別のブックにシートをコピ...
-
【ExcelVBA】zip圧縮されたCSV...
-
【ご教示ください】VBAの記述方...
-
2つ目のコンボボックスが動作...
-
VBA 実行時エラー 2147024893
-
Excel VBA 指定したセル範囲の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
VBA 別ブックからコピペしたい...
-
別ブックをダイアログボックス...
-
エクセルVBAが途中で止まります
-
ワイルドカード「*」を使うとう...
-
【Excel VBA】書き込み先ブック...
-
VBAで別ブックのシートを指定し...
-
【ExcelVBA】zip圧縮されたCSV...
-
VBAで別のブックにシートをコピ...
-
VBA コードを実行すると画面が...
-
Excel2007VBAファイルの表示に...
-
VBAで複数のブックを開かずに処...
-
[Excel]ADODBでNull変換されて...
-
Excelファイルを開くとき、読み...
-
VBA 実行時エラー 2147024893
-
Excelマクロ 該当する値の行番...
-
Excel にて、 リストボックスの...
-
VBS Bookを閉じるコード
-
複数のエクセルファイルとシー...
-
【ExcelVBA】インデックスが有...
おすすめ情報
ご回答ありがとうございます。以下、途中のマクロです。
Dim i As Long
Dim a As Long
Dim x As Long
Dim aa As Long
Dim TmpSheet As Worksheet, wc As Integer
Dim wLastGyou As Long
Dim Path As String
Dim myFile As String
Path = ThisWorkbook.Path & "\"
myFile = Dir(Path & "*.xls*")
Do Until myFile = ""
'If myFile <> ThisWorkbook.Name Then
If InStr(myFile, ".xlsm") = 0 Then
Workbooks.Open Path & myFile
Set TmpSheet = Worksheets.Add(Before:=Sheets(1))
With Worksheets(2)
If .Cells(34, 1) <> "" Then
For a = 3 To 9
Worksheets(1).Cells(b + 7, 1).Value = Worksheets(2).Range("E6").Value
Next a
End If
End With
With Worksheets(1)
wLastGyou = .UsedRange.Rows.Count
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
x = .UsedRange.Cells(.UsedRange.Count).Row
For aa = x To 1 Step -1
If .Cells(aa, "D").Text = "0" Then .Rows(aa).Delete
Next
End With
Dim first As Object
Set first = ActiveWorkbook
Worksheets(1).Select
Worksheets(1).Move
Dim wb As Workbook, fn As String, ix As Long, temp As String
With ActiveWorkbook
temp = Path & Format(first.Sheets(1).Range("D5").Value)
fn = Dir(temp & ".csv")
If fn = "" Then
fn = temp & ".csv"
Else
Do While fn <> ""
ix = ix + 1
fn = Dir(temp & "(" & Format(ix + 1, "0") & ")" & ".csv")
Loop
fn = temp & "(" & Format(ix + 1, "0") & ")" & ".csv"
End If
.SaveAs fn, _
FileFormat:=xlCSV
.Close
fn = ""
ix = 0
End With
first.Activate
first.Save
first.Close
'=====各処理ここまで
End If
myFile = Dir() '←このコードにすると、1つ目のブックは成功し、その次から実行時エラー5、プロシージャの呼び出し、または引数が不正です。というエラーが出ます
'Dir (Path & "*.xls") '←こちらのコードにすると同ブック上で永遠にループします
Loop
End Sub
見づらくて申し訳ありません;