こんにちは。
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で質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一回も披露したことのない豆知識
- ・これ何て呼びますか
- ・チョコミントアイス
- ・初めて自分の家と他人の家が違う、と意識した時
- ・「これはヤバかったな」という遅刻エピソード
- ・これ何て呼びますか Part2
- ・許せない心理テスト
- ・この人頭いいなと思ったエピソード
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・あなたの習慣について教えてください!!
- ・ハマっている「お菓子」を教えて!
- ・高校三年生の合唱祭で何を歌いましたか?
- ・【大喜利】【投稿~11/1】 存在しそうで存在しないモノマネ芸人の名前を教えてください
- ・好きなおでんの具材ドラフト会議しましょう
- ・餃子を食べるとき、何をつけますか?
- ・あなたの「必」の書き順を教えてください
- ・ギリギリ行けるお一人様のライン
- ・10代と話して驚いたこと
- ・家の中でのこだわりスペースはどこですか?
- ・つい集めてしまうものはなんですか?
- ・自分のセンスや笑いの好みに影響を受けた作品を教えて
- ・【お題】引っかけ問題(締め切り10月27日(日)23時)
- ・大人になっても苦手な食べ物、ありますか?
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
ワイルドカード「*」を使うとう...
-
別ブックをダイアログボックス...
-
VBA 別ブックからコピペしたい...
-
エクセルVBAが途中で止まります
-
Excelマクロ 該当する値の行番...
-
【Excel VBA】書き込み先ブック...
-
エクセル共有化のトラブル
-
VBAで別ブックのシートを指定し...
-
vbaで他のブックに転記したい。...
-
VBA コードを実行すると画面が...
-
Excelのマクロについて教えてく...
-
VBA アプリケーション定義また...
-
マクロを使って不特定のファイ...
-
【VBA】別のブックの同じ行番号...
-
Excelファイルを開くとき、読み...
-
エクセルのマクロを使ってメー...
-
VBAで複数のブックを開かずに処...
-
VBの処理結果をEXCELシ...
-
エクセルマクロで、他ブックか...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
別ブックをダイアログボックス...
-
エクセルVBAが途中で止まります
-
ワイルドカード「*」を使うとう...
-
VBA 別ブックからコピペしたい...
-
【ExcelVBA】インデックスが有...
-
VBA コードを実行すると画面が...
-
VBAで別ブックのシートを指定し...
-
【ExcelVBA】zip圧縮されたCSV...
-
VBAで別のブックにシートをコピ...
-
VBA 実行時エラー 2147024893
-
VBA シート名が一致した場合の...
-
ユーザーフォームの切り替えに...
-
【マクロ】違うフォルダにある...
-
【Excel VBA】書き込み先ブック...
-
VBS Bookを閉じるコード
-
Excelマクロ 該当する値の行番...
-
VBAで複数のブックを開かずに処...
-
Excel2007VBAファイルの表示に...
-
VBA アプリケーション定義また...
おすすめ情報
ご回答ありがとうございます。以下、途中のマクロです。
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
見づらくて申し訳ありません;