エクセルワークブックの数だけ処理を繰り返したいです

質問

excel vba（マクロ）についての質問です。

元のフォルダには、複数の.xlsxのワークブックがあります。この各ワークブックのワークシート1のA1に”〇月見積書”と記載があり、これらを元のフォルダと同じフォルダに各ワークブックのワークシート1のA1に記載があるファイル名にし、かつ、csvにして保存し、同じファイル名になったら、連番にしたいです。
例えば、"11月見積書(1)"の様に。そして、元の.xlsxの数だけ連番にしたいです。
元のフォルダにある.xlsxをカウントしてその分だけ繰り返せばいいと思うのですが、連番が永遠と繰り返されてしまい、出来ません。
各.xlsxをワークブックのワークシート1のA1に記載があるファイル名にし、そして、この.xlsxの分だけ.csvに変換するには、どうすればいいでしょうか？

dim f as string
dam i as long
dim tem as string

tem = thisworkbook.sheets(1).range("A1") & "¥"
f = dir(tem)
if f ="" then
f= tem
else
do while f<>""
i = i+1
f= dir(tem& "(" & i &")" & ".csv")
loop
f =tem & "(" & i &")" & ".csv"
end if
activeworkbook.save as filename:=tem & "(" & i &")" & ".csv"

お手数ですが、宜しくお願い致します。

回答No.5

SI299792 · ベストアンサー

返事が遅れてすみません。
こちらでは正しく動いているので、原因は解りません。
上げておくのでダウンロードして動かしてみて下さい。
https://1drv.ms/u/s!AnfEM367OeSdiG3oN79IlJuaR1ZZ?e=TjwTUu

考えれる可能性としては、１番左のシートのA1が空白になっている等ありませんか。

それでも解らない場合、
データ便
https://www.datadeliver.net/1
OneDrive
https://www.microsoft.com/ja-jp/microsoft-365/free-office-online-for-the-web
等に上げていただければ見てみます。

お礼

ご連絡が遅くなり、失礼しました。

ありがとうございます！お蔭様で、動きました！どうやら、大本のxlsxが読み取り専用になっていたのが原因でした。

ありがとうございました！

回答No.4

SI299792

いえ、こちらこそ質問を読み返しても、どこにも全シートと書いてありませんでした。私の読み間違いです。
多分原因は他シートを処理しようとしてA1が空白だったので異常動作したと思われます。
（原因が思い当たらずしばらく放置していました）
１番左だけを処理対象にしました。やってみて下さい。
Option Explicit
'
Sub Macro1()
　　Dim Sheet As Worksheet
　　Dim FileName As String
　　Dim Count As String
'
　　FileName = Dir(ThisWorkbook.Path & "\*.xlsx")
　　Application.ScreenUpdating = False
'
　　Do While FileName > ""
　　　　Workbooks.Open ThisWorkbook.Path & "\" & FileName, False, True
　　　　Sheets(1).Select
　　　　Count = 0
　　　　On Error Resume Next
'
　　　　Do While Err = 0
　　　　　　FileName = ThisWorkbook.Path & "\" & _
　　　　　　　　Replace([A1] & "(" & Count & ")", "(0)", "") & ".csv"
　　　　　　Open FileName For Input As #1
'
　　　　　　If Err <> 0 And Err <> 53 Then
　　　　　　　　Error Err
　　　　　　End If
　　　　　　Close
　　　　　　Count = Count + 1
　　　　Loop
　　　　On Error GoTo 0
　　　　ActiveWorkbook.SaveAs FileName, FileFormat:=xlCSV
　　　　ActiveWorkbook.Close False
　　　　FileName = Dir
　　Loop
　　End
End Sub

補足

新たにご教示いただきまして、ありがとうございます。

ただ、すいません。いただいたプログラムを走らせると、「実行時エラー1004 ファイルにアクセスできませんでした。」と出てしまい、エラーになってしまいます。

activeworkbook.save as 〜が該当の様です。
この箇所を、activeworkbook.savbas filename:=として保存すると、エラーは出てこないのですが、代わりに、名前の重複処理が出来なくなります。（名前が重複するファイルあるけど、保存する？というメッセージが出ます。）

お手数ですが、他の方法をご教示いただげせんでしょうか？

申し訳ありませんが、宜しくお願い致しますm(_ _)m

回答No.3

SI299792

＞ワークシート1のA1に
というのを見落としていました。
という事は、ワークシート1のA1だけ入っていて、他シートは入っていないのでしょうか。

全てのシートが対象だと思っていたのですが、１番左だけでいいのですか？

補足

言葉足らずで失礼しました。
はい、仰る通り、ワークシート1のA1だけで大丈夫です。

回答No.2

SI299792

フォルダは、このワークブックを保存したフォルダと同じフォルダにしました。
Option Explicit
'
Sub Macro1()
　　Dim Sheet As Worksheet
　　Dim FileName As String
　　Dim Count As String
'
　　FileName = Dir(ThisWorkbook.Path & "\*.xlsx")
　　Application.ScreenUpdating = False
'
　　Do While FileName > ""
　　　　Workbooks.Open ThisWorkbook.Path & "\" & FileName, False, True
'
　　　　For Each Sheet In Worksheets
　　　　　　Sheet.Select
　　　　　　Count = 0
　　　　　　On Error Resume Next
'
　　　　　　Do While Err = 0
　　　　　　　　FileName = ThisWorkbook.Path & "\" & _
　　　　　　　　　　Replace([A1] & "(" & Count & ")", "(0)", "") & ".csv"
　　　　　　　　Open FileName For Input As #1
　　　　　　　　Close
　　　　　　　　Count = Count + 1
　　　　　　Loop
　　　　　　ActiveWorkbook.SaveAs FileName, FileFormat:=xlCSV
　　　　Next Sheet
　　　　ActiveWorkbook.Close False
　　　　FileName = Dir
　　Loop
End Sub

補足

ご意見いただき、ありがとうございます。

ただ、すいません。ご教示いただきましたプログラムを走らせたのですが、何も起きずに醜虜してしまいます。
〉Open FileName For Input As #1

で動作が止まってしまうみたいたのです。

大変申し訳ありませんが、もし宜しければ、他の方法をご教示いただけますと幸いです。

回答No.1

imogasi

こんな質問は、タイプとしてはよくあることだ。
（１）FSOを使う
（２）Dirを使う
の２方式あるが、For Eachが使える（１）がお勧め。
Googleで「fso folderのファイルを捉える」などで照会し
https://excelwork.info/excel/fsofiles/
などの記事が出てくるから、その中の例の（一部を修正し）
ーーー
Sub Sample_Files()
Dim fso As Object
Dim myFiles As Object
Dim myFile As Object
Dim strFiles As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set myFiles = fso.GetFolder("C:\Users\XXXX").Files　’xxxx以下は修正する
i = 1
For Each myFile In myFiles
strFiles = myFile.Name
MsgBox strFiles
i = i + 1
If i = 3 Then Exit Sub　’確認なので、３ファイルで打ち切る
Next
End Sub
これで、結果が、おかしいところが無いようなら
MsgBox strFiles
のところを、ブックstrFilesのOpenに変える。
その次に、そのブックのOpen後の処理のコードを書く（質問のコードが使えるか、やって見たら）。
質問者だけの、固有の処理ニーズなので自力でやること。
回答者に全部やらすのは、勉強にもならず、自分でやってみること。
疑問があればそのコードについて質問すること。
参考
https://teratail.com/questions/201039
Early BindingとLate Bindingについて
のうち、初心者に、やさしいと思う方をやっている。