VBAでエクセルをCSVに変換時

質問

業務上、エクセルファイルのデータをCSV変換し、他のソフトへコンバートする
作業を行う事になったのですが、初心者なので全くわからず、
ネットの力に頼ってVBAでCSV変換するコマンドまでは作成できたのですが、
コンバート先のソフトへは、以下(1)、(2)の設定が不足している事がわかりました。
現在利用しているコマンドにその機能を持たせる事は可能でしょうか。

(1)文字コードをUTF-8へ指定
(2)改行コードをLFへ指定

VBAのバージョン：VisualBasic6.5

Sub Test()
Dim ws As Worksheet
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
ws.SaveAs ThisWorkbook.Path & "\" & ws.Name & ".csv", xlCSV
Next ws
End Sub

初めての質問なので内容が解りづらいと思いますが申し訳ありません。
ご回答をお待ちしております。

回答No.2

cj_mover · ベストアンサー

こんにちは。
一応、仰せのまま、書いてみました。
セル内のカンマ（桁区切りの数値とか）だけは
Excelのcsv保存の仕様に合わせて手当てしてますが、
完全とは言えないです。
csv経由で移植する際は
　3-11-22
のような（住所の番地だけ抜き出したような）セル値が化けることがあったり、
注意深く作業にあたった方がよいです。
ところで、Excel2007？ですよね？
csv以外にも方法があるなら、もっと簡単に出来たりするような気もしますけれど。

大雑把な処理の流れだけコメントにしておきました。
簡単なことしかしてないけれど、易しくはないでしょうね。
とりあえず、試してみてください。

（追記）書いてるうちに回答ありましたが、せっかく書いたので、、、。

Option Explicit

Sub Re8057743()
' ' シートデータを "UTF-8" Lf改行 csvテキストで出力
' ' 解り易くする為に、すべて直値で統一。
　　Dim oDTObj　　　As Object ' DataObject
　　Dim oRegExp　　 As Object ' RegExp
　　Dim oADODB_Strm As Object ' ADODB.Stream
　　Dim ws　　　As Worksheet
　　Dim sPath　 As String ' Path & "\"
　　Dim sBuf　　As String

' ' 保存先のパス
　　sPath = ThisWorkbook.Path & "\"

' ' クリップボードからテキストデータを読み込む為の DataObject
　　Set oDTObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' New DataObject

' ' テキスト整形用の RegExp（正規表現）
　　Set oRegExp = CreateObject("VBScript.RegExp")
　　oRegExp.Global = True

' ' テキストを "UTF-8" で出力する為の ADODB.Stream
　　Set oADODB_Strm = CreateObject("ADODB.Stream")
　　oADODB_Strm.Charset = "UTF-8"

'　　On Error Resume Next ' ??
' ' シートをループ
　　For Each ws In ActiveWorkbook.Worksheets

' ' セル範囲をコピー → クリップボードへ
' ' セル範囲は運用に合わせて適宜指定
　　　　ws.UsedRange.Copy

' ' テキストデータをクリップボードから DataObject を介して ｓBufに格納
' ' この時点では、tsv（tab区切り）テキスト
　　　　With oDTObj
　　　　　　.GetFromClipboard
　　　　　　sBuf = .GetText
　　　　　　.Clear
　　　　End With

' ' 正規表現でテキストデータを整形
　　　　With oRegExp
' ' CrLf を Lf に置換
　　　　　　.Pattern = "\s?\r(\n)"
　　　　　　sBuf = .Replace(sBuf, "$1")
' ' セルの値に"," が含まれるなら、セルの値を DQ（"）で括るように置換
　　　　　　.Pattern = "([^\t\n]*\,[^\t\n]*)"
　　　　　　If .Test(sBuf) Then sBuf = .Replace(sBuf, """$1""")
' ' tsv を csv に変換（タブをカンマに置換）
　　　　　　.Pattern = "\t"
　　　　　　sBuf = .Replace(sBuf, ",")
　　　　End With

' ' ストリームファイルで "UTF-8" 出力
　　　　With oADODB_Strm
　　　　　　.Open
　　　　　　.WriteText sBuf
　　　　　　.SaveToFile sPath & ws.Name & ".csv", 2
　　　　　　.Close
　　　　End With

　　Next ws

　　Application.CutCopyMode = False
　　Set oDTObj = Nothing:　　Set oRegExp = Nothing:　　Set oADODB_Strm = Nothing
End Sub

お礼

早速上記の構文で実践させていただきました
完璧です。どうお礼をしたらよいのかわかりません。
本当にどうもありがとうございました！！

回答No.3

noname#217196

技術的には可能ですが、あなたがスムーズかつメンテナンスしやすいようにプログラミングできるかどうか、ちゃんと検証できるかどうかは別の話です。

テキストファイル出力方法、テキストファイル出力時の文字エンコード指定方法、ＯＳによる文字エンコード／ＢＯＭ／改行コードの違いを技術解説書等（Webサイトだと、Excelの学校、moug、Office TANAKA、インストラクターの独り言などがExcelの高度な使い方を知るには有効です）で勉強の上で、Excel VBAでプログラミングするか、いったん出力したＣＳＶファイルに対し、ファイル・コンバータやテキスト置換ユーティリティツール（nkfとか）で処理するか（ＦＴＰツールでも可）、TeraPad、秀丸エディタなどのテキストエディタでＣＳＶファイルを開いて、文字エンコードと改行コードを指定して保存しなおしても対応可能です。
運が良ければ、ＦＦＦＴＰのようなＦＴＰツールやnkfでWindows用のテキストファイルからたとえばＬｉｎｕｘ用のテキストファイルに変換しておしまいです。いずれにしろ、コンバート先のソフトが受け入れ可能なＣＳＶファイルの仕様定義書で、ほかにも事前チェックしておかないとまずいこと（日付書式、項目ごとの制約条件、最大行数、ファイル名規則など）が抜け落ちていないか確認してからでないと完了のめどが立たないでしょう。使ってみてから不足している機能や詰めが甘い仕様が判明する都度プログラムの修正が必要になり一進一退を繰り返すのは避けたいところです。

なお、ExcelのＣＳＶファイル出力は、Ｅｘｃｅｌで開く上では目立ちませんがバグっぽい点があるので、単純にSaveAsでxlCSVを指定して安心しないでください。ExcelがＣＳＶファイルに出力する単位はたしか１６行（バージョンによって異なる可能性があります。また新しめのバージョンで以下の問題が解消されている可能性もあります）で、１６行単位ごとにチェックして最大項目数を決めています。このためデータの入力がないセルが最終項目に１６行単位で連続してあるときは期待した最大項目数より少なく出力されてしまいます。逆に最終項目列の右側にあやまって入力したデータを削除してもダーティ・セルとしてマーキングされて、最大項目数より多く出力されることがあります。書式設定により数値データの右側に空白文字がつくケースもあります。ほかに悩ましいのが、Ｅｘｃｅlのワークシート上では正常に表示された文字や記号が、ＣＳＶファイルへの出力時にＵＴＦ１６ＬＢからＳＨＩＦＴ ＪＩＳ（ＭＳ９３２）へコンバートされることで文字化けする可能性が出てくること。round trip conversionが保証されていない符号類（代表例は、~）をデータに含んでいる場合も厄介です。ＣＳＶファイルに出力する前にエラーデータのあるセルを特定できる仕組みか、出力したＣＳＶファイルに対しエラーデータを全件特定できる仕組みがふつうは必要です。

インポート先のシステムが、定義しているインポート可能なＣＳＶファイルは、項目名つきか否か、データ項目値は二重引用符で括る（データ自体に二重引用符を含む場合はエスケープ処理を施す。この指定は、数値の書式に桁区切りカンマを使用しているなどデータ自体にカンマを含むことを許容している場合に必要になります）のか否か、特定項目の文字長や数値の有効桁数に制限があるか否か等、システムによって様々なので、対応可能なプログラムを自作するなり、業者に開発依頼して用意しておくことも検討するとよいと思います。

お礼

『ＦＦＦＴＰのようなＦＴＰツールやnkfでWindows用のテキストファイルからたとえばＬｉｎｕｘ用のテキストファイルに変換』
そんな事もできるんですね・・・まったく知りませんでした。
ご教授いただいた内容について、今後のお役に立てさせて頂きたいと思います。
皆さん本当にご親切で、勇気を出して質問して本当によかったです
どうもありがとうございました。

回答No.1

mitarashi

UTF-8のCSVを読む方は作成した(切り貼りした）事がありましたが、書き出す方はストックになかったのでやってみました。
参考URLのコードをお借りしてアレンジすると、こんな感じです。
保存するセル範囲をUsedRangeで取得しておりますが、意図に反する場合もあるかと思います。
また、ADODB.Streamを都度作成しては破棄しているので効率は悪いと思いますが、ブック一つ分のシート数程度なら問題にならないでしょう。
Microsoft Active Data Object 2.x Library(最近では...Object 6.xというのもありますが）に参照設定が必要です。
Sub test()
Dim ws As Worksheet

On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
makeUTF8CSV ws.UsedRange, ThisWorkbook.Path & "\" & ws.Name & ".csv"
Next ws
End Sub

Sub makeUTF8CSV(targetRange As Range, destFilePath As String)
Dim i As Long
Dim j As Long
Dim strList As String
Dim adoSt As ADODB.Stream

Set adoSt = New ADODB.Stream
With adoSt
.Type = adTypeText
.Charset = "UTF-8"
.LineSeparator = adLF
.Open
End With
With targetRange
For i = 1 To .Rows.Count
strList = ""
For j = 1 To .Columns.Count
If j > 1 Then
strList = strList & ","
End If
strList = strList & .Cells(i, j)
Next
adoSt.WriteText strList, adWriteLine
Next
End With
adoSt.SaveToFile destFilePath, adSaveCreateOverWrite
adoSt.Close
Set adoSt = Nothing
End Sub

※参照設定については下記ページの下半分をご覧下さい。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_030.html

参考URL：

http://excel-ubara.com/EXCEL/EXCEL220.html