VBA フォルダの中のxlsxファイルをcsvで保存する方法

フォルダの中に複数のxlsxファイルがあり、全てをそれぞれのブック名でcsvで保存する方法について悩んでいます。

フォルダの中のファイルをすべて処理するコードについては、あるサイトで掲載されていたコードを利用しています。

以下のとおりに書きましたが、「Save Asメソッドは失敗しました。'Workbook'オブジェクト」というエラーが出てしまいます。
また、できれば、UTF-8に変えて保存したいと思っています。

書いたコードは以下のとおりです。
Subの部分は省略しています。


Dim FileName As String
Dim path, fso, file, files
path = "（パス名）"
Set fso = CreateObject ( Scripting. FileSystemObject')
Set files = fso. GetFolder (path). files
For Each file in files
Dim wb As Workbook
Set wb = Workbooks. Open (file)

ブックに対する処理

Dim book1 As Workbook
Set book1 = ActiveWorkbook
Dim X As String
X = Left (book1. Name, Len (book1. Name) - 5) &"CSV"
book1. SaveAs Filename:=X, _
FileFormat :="XICSV"
Next file

「FileFormat :="XICSV"」部分をカットすると、1つずつcsvは作成されますが、開いてみると文字化けしてしまっています。

ご回答いただけると助かります。

行動規範の内容に同意します

回答2件

ベストアンサー

FileForamtに指定するのは文字列ではなく、XlFileFormat 列挙体です。
https://docs.microsoft.com/ja-jp/office/vba/api/excel.xlfileformat
省略時は「既定値は、使用されている Excel のバージョンの形式です。」なので、いわゆるExcelフォーマットになっているはずです。
https://docs.microsoft.com/ja-jp/office/vba/api/excel.workbook.saveas
つまりファイル名だけはCSVになってますが、中身はExcelのまま保存されているのではと思います。
（試しに拡張子をelsxに変えてみると正しく開けるはずです）
よって正しくCSVファイルとして保存、尚且つUTF8で保存するのであれば、FileFormatの行を次のようにしてください。

VBA
1FileFormat :=xlCSVUTF8

※UTF8に保存するのはやったことがないので問題あればコメントください。こちらでも試してみます。

追記
不要な処理や、無駄な空白、生成するファイル名の間違い、オブジェクトの後始末など足りていなかったのでコードを整理しました。
こちらでどうでしょうか。
ちなみにxlCSVUTF8はExcel2016からだそうで、私の環境では試せませんでした。

VBA
1Dim FileName As String
2Dim path, fso, file, files
3Dim wb As Workbook
4Dim book1 As Workbook
5Dim X As String
6
7path = "（パス名）"
8
9Set fso = CreateObject("Scripting.FileSystemObject")
10Set files = fso.GetFolder(path).files
11
12For Each file In files
13    Set wb = Workbooks.Open(file)
14    X = Left(wb.Name, Len(wb.Name) - 5) & ".CSV"
15    wb.SaveAs FileName:=X, FileFormat:=xlCSVUTF8
16    wb.Close
17    Set wb = Nothing
18Next file
19Set fso = Nothing

投稿2019/10/10 04:26

編集2019/10/10 05:09

ttyp03

総合スコア16998

kagome96

2019/10/10 04:55

ご回答ありがとうございます。試してみましたが、同じエラーが出てしまうようです。（Save Asメソッドは〜）

ttyp03

2019/10/10 05:10

整理したコードを回答に追記しましたので、こちらで試していただけますか。

kagome96

2019/10/10 05:17

ありがとうございます。やはり、wb.SaveAsの文でエラーが出てしまいます。なんども申し訳ありません。

ttyp03

2019/10/10 05:30

何のエラーですか？少なくともこちらで試した限りではエラーは出てません。

tatsu99

2019/10/10 06:04

質問者様のexcelのバージョンはexcel2016でしょうか？

ttyp03

2019/10/10 06:16

こちらはExcel2013のため、試し実行はxlCSVで行いました。もしバージョンがわからないようであれば、一度xlCSVでお試しください。

kagome96

2019/10/10 13:23

ご返信遅くなり申し訳ありません。 excel2016ですが、バージョンが古い？のが問題なのだと思っています。 xlCSVではうまくいきました。本当にありがとうございました。助かりました。

ttyp03

2019/10/10 14:26

2016ならxlCSVUTF8で動きそうですけどね。 xlCSVだとUTF8では出力されてないはずなのでお忘れなく。

行動規範の内容に同意します

開いてみると文字化けしてしまっています。

手動でやってみても、文字化けしますか？
出来たテキストファイルを開くときはどんなアプリ使ってますか？

https://did2memo.net/2016/11/14/excel-csv-utf8/
http://acoustic-groove.hatenablog.com/entry/2017/11/11/003157
https://tonari-it.com/excel-vba-utf8-write/

手動で出来てるなら、

ExcelVBA
1Sub Macro1()
2    Dim wb As Workbook
3    Dim sFileName As String
4
5    Set wb = ActiveWorkbook
6    sFileName = Replace(wb.Name, "xlsx", "csv")
7
8    Application.DisplayAlerts = False
9    ActiveWorkbook.SaveAs Filename:=wb.Path & "\" & sFileName, _
10                          FileFormat:=xlCSVUTF8, CreateBackup:=False
11    Application.DisplayAlerts = False
12End Sub