accessを使って256列以上のデータをCSVにエクスポートしたい

Question

accessで256列以上のデータをCSVにエクスポートしたい

困っていること： あるシステムにデータを取り込むためのCSVファイルを作成しようとしています。そのシステムの取り込みファイルは276列ありますが、accessではテーブルに255列までしか作成できないため、データ取込み用CSVファイルが作成できません。

やったこと： とりあえず作成できる列まで1つのテーブルで作成し、残りの列はVBAでCSVに直接書き込みに行くような形でヘッダだけは276列まで作ることができました。
検索していろんな方のコードを参考に作ったものなので、つぎはぎ感がすごいですが、何とかできました。
付け足した20列ほどは全て空のセルなので、何も値は入らないですが、入力データフォーマットが取り込む行すべてに指定の276列ないと取り込めないため、ヘッダだけ作成してもでは取り込むことができません。（苦労してヘッダだけ作った意味はなかったみたいです。）

作ったものは以下です。やりたいことがご理解いただきやすいかと思い念のために掲載しておきます。
お知恵を拝借できますと幸いです。どうぞよろしくお願い致します。

Private Sub ファイル出力_Click()
  
   DoCmd.SetWarnings False
  
  DoCmd.OpenQuery "T_TUGデータ追加"
    
  
  DoCmd.TransferText _
    TransferType:=acExportDelim, _
    TableName:="T_TUGXray", _
    filename:="V:\フォルダ\TUG" & ".csv", _
    HasFieldNames:=True
    
      
' Private Sub ExTextWrite()
'    Dim fno As Integer
'    fno = FreeFile
'    TableName = "T_TUGXray"
'    Open "V:\フォルダ\TUG.csv" For Append As fno
'    Print #fno, TableName
'    Close fno
'End Sub


Dim xlsApp As Object
Dim xlsbook As Object
Dim xlsSheet As Object

Dim filename As String

 

filename = "V:\フォルダ\TUG.csv"

Set xlsApp = CreateObject("Excel.Application")

xlsApp.DisplayAlerts = False 

Set xlsbook = xlsApp.Workbooks.Open(filename)

Set xlsSheet = xlsbook.worksheets(1)


With xlsSheet

'行を削除
.Rows(1).Delete

End With

'保存
xlsbook.Save

xlsApp.Application.Quit

Set xlsSheet = Nothing
Set xlsbook = Nothing
Set xlsApp = Nothing


'ヘッダ挿入
    
Const ForReading = 1
Const ForWriting = 2
Dim objFSO As Object
Dim objFile As Object
Dim strContents As String
Dim strFirstLine As String
Dim strNewContents As String
Dim strPath As String

strPath = "V:\フォルダ\TUG.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strPath, ForReading)
 
strContents = objFile.ReadAll
objFile.Close
 
strFirstLine = "1" & "," & "2" & "," & "3" & "," & "4" & "," & "5" & "," & "6" & "," & "7" & "," & "8" & "," & "9" & "," & "10" & "," & "11" & "," & "12" & "," & "13" & "," & "14" & "," & "15" & "," & "16" & "," & "17" & "," & "18" & "," & "19" & "," & "20" & "," & "21" & "," & "22" & "," & "23" & "," & "24" & "," & "25" & "," & "26" & "," & "27" & "," & "28" & "," & "29" & "," & "30" & "," & "31" & "," & "32" & "," & "33" & "," & "34" & "," & "35" & "," & "36" & "," & "37" & "," & "38" & "," & "39" & "," & "40" & "," & "41" & "," & "42" & "," & "43" & "," & "44" & "," & "45" & "," & "46" & "," & "47" & "," & "48" & "," & "49" & "," & "50" & "," & "51" & "," & "52" & "," & "53" & "," & "54" & "," & "55" & "," & "56" & "," & "57" & "," & "58" & "," & "59" & "," & "60" & "," & "61" & "," & "62" & "," & "63" & "," & "64" & "," & "65" & "," & "66" & "," & "67" & "," & "68" & "," & "69" & "," & "70" & "," & "71" & "," & "72" & "," & "73" & "," & "74" & "," & "75" & "," & "76" & "," & "77" & "," & "78" & "," & "79" _
 & "," & "80" & "," & "81" & "," & "82" & "," & "83" & "," & "84" & "," & "85" & "," & "86" & "," & "87" & "," & "88" & "," & "89" & "," & "90" & "," & "91" & "," & "92" & "," & "93" & "," & "94" & "," & "95" & "," & "96" & "," & "97" & "," & "98" & "," & "99" & "," & "100" & "," & "101" & "," & "102" & "," & "103" & "," & "104" & "," & "105" & "," & "106" & "," & "107" & "," & "108" & "," & "109" & "," & "110" & "," & "111" & "," & "112" & "," & "113" & "," & "114" & "," & "115" & "," & "116" & "," & "117" & "," & "118" & "," & "119" & "," & "120" & "," & "121" & "," & "122" & "," & "123" & "," & "124" & "," & "125" & "," & "126" & "," & "127" & "," & "128" & "," & "129" & "," & "130" & "," & "131" & "," & "132" & "," & "133" & "," & "134" & "," & "135" & "," & "136" & "," & "137" & "," & "138" & "," & "139" & "," & "140" & "," & "141" & "," & "142" & "," & "143" & "," & "144" & "," & "145" & "," & "146" & "," & "147" & "," & "148" & "," & "149" & "," & "150" & "," & "151" & "," & "152" _
 & "," & "153" & "," & "154" & "," & "155" & "," & "156" & "," & "157" & "," & "158" & "," & "159" & "," & "160" & "," & "161" & "," & "162" & "," & "163" & "," & "164" & "," & "165" & "," & "166" & "," & "167" & "," & "168" & "," & "169" & "," & "170" & "," & "171" & "," & "172" & "," & "173" & "," & "174" & "," & "175" & "," & "176" & "," & "177" & "," & "178" & "," & "179" & "," & "180" & "," & "181" & "," & "182" & "," & "183" & "," & "184" & "," & "185" & "," & "186" & "," & "187" & "," & "188" & "," & "189" & "," & "190" & "," & "191" & "," & "192" & "," & "193" & "," & "194" & "," & "195" & "," & "196" & "," & "197" & "," & "198" & "," & "199" & "," & "200" & "," & "201" & "," & "202" & "," & "203" & "," & "204" & "," & "205" & "," & "206" & "," & "207" & "," & "208" & "," & "209" & "," & "210" & "," & "211" & "," & "212" & "," & "213" & "," & "214" & "," & "215" & "," & "216" & "," & "217" & "," & "218" & "," & "219" & "," & "220" & "," & "221" & "," & "222" & "," & "223" & "," & "224" _
 & "," & "225" & "," & "226" & "," & "227" & "," & "228" & "," & "229" & "," & "230" & "," & "231" & "," & "232" & "," & "233" & "," & "234" & "," & "235" & "," & "236" & "," & "237" & "," & "238" & "," & "239" & "," & "240" & "," & "241" & "," & "242" & "," & "243" & "," & "244" & "," & "245" & "," & "246" & "," & "247" & "," & "248" & "," & "249" & "," & "250" & "," & "251" & "," & "252" & "," & "253" & "," & "254" & "," & "255" & "," & "256" & "," & "257" & "," & "258" & "," & "259" & "," & "260" & "," & "261" & "," & "262" & "," & "263" & "," & "264" & "," & "265" & "," & "266" & "," & "267" & "," & "268" & "," & "269" & "," & "270" & "," & "271" & "," & "272" & "," & "273" & "," & "274" & "," & "275" & "," & "276"


strNewContents = strFirstLine & vbCrLf & strContents
 
Set objFile = objFSO.OpenTextFile(strPath, ForWriting)
objFile.WriteLine strNewContents
 
objFile.Close



  DoCmd.RunSQL "DELETE * from T_TUG"
      
  MsgBox "作成完了", vbOKOnly
  
  DoCmd.SetWarnings True
  
  
End Sub

Comments

[yorozuya]

必要なデータは「T_TUGXray」テーブルに入っている、ということでよろしいのですね。
あと21列の空の列を追加したい、ということでよろしいのですね。
方法は４通り位ですかね。
(1) テーブルを１レコードずつ読み、地味に276列CSVファイルに吐き出す。
(2) テーブルからCSVファイルを吐き出して、エクセルで加工して、CSVとして保存する。
(3) テーブルからエクセルにエクスポートし、エクセルを加工して、CSVとして保存する。
(4) テーブルから CopyFromRecordset でエクセルに貼付、エクセルを加工し、CSVとして保存する。
全部のサンプル作成は避けたいので、お望みのものはどれでしょう。

[msug]

ありがとうございます。
（１）の「テーブルを１レコードずつ読み、地味に276列CSVファイルに吐き出す。」の方法でお願いできますでしょうか。

データのIDが0から始まるテキストになっておりますため、エクセルで開くという処理が入ると数値に変換されてしまったりデータ型が崩れてしまいう、という事がございましたので、できればExcelを挟まないようにしたいなと思いました。

[yorozuya]

CSVファイルの文字コードは何にしますか？
(1) ShiftJIS
(2) UTF-8
(3) UNICODE(Windows内部形式）
(4) その他
改行コードは何にしますか
(1) 復帰改行（2バイト）
(2) 改行のみ（UNIX用）
(3) 復帰のみ（MAC用）

[yorozuya]

項目名は ”（ダブルクォーテーション）で囲みますか？
データ中に ”（ダブルクォーテーション）で囲むべき項目はありますか？

[msug]

文字コードは(2)UTF-8
改行コードは(1)復帰+改行
項目名はダブルクォーテーションで囲みます。
追加するデータは全て空白ですが、””で表現すると思っているのですが、私がそもそもよくわかっていないため質問にうまく答えられず。。すみません。
このような回答で大丈夫でしょうか

[yorozuya]

CSVファイルをメモ帳で開いて見たときに、どんな形になっていて欲しいかです。

[msug]

そうなのですね！すみません。
ダブルクオーテーションは不要です。
データ中にダブルクオーテーションで囲む項目はございません。

Answer 1

Option Compare Database
Option Explicit

Private Sub CSV出力_Click()
    Dim cn As Object, rs As Object
    Set cn = CurrentProject.Connection
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "T_TUGXray", cn, 3, 1
    Dim strPath As String, Stream As Object
    strPath = "V:\フォルダ\TUG.csv"
    Set Stream = CreateObject("ADODB.Stream")
    Stream.Charset = "UTF-8"
    Stream.Open
    Dim strContents As String, i As Long
    strContents = ""
    For i = 0 To rs.Fields.Count - 1
        strContents = strContents & rs.Fields(i).Name & ","
    Next i
    strContents = strContents & "256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276"
    Stream.WriteText strContents & vbCrLf
    Do Until rs.EOF
        strContents = ""
        For i = 0 To rs.Fields.Count - 1
            strContents = strContents & rs.Fields(i).Value & ","
        Next i
        strContents = strContents & ",,,,,,,,,,,,,,,,,,,,"
        Stream.WriteText strContents & vbCrLf
        rs.MoveNext
    Loop
    Stream.SaveToFile strPath, 2
    Stream.Close
    Set Stream = Nothing
    rs.Close
    Set rs = Nothing
    Set cn = Nothing
End Sub

Comments

[msug]

完ぺきに出来上がりました。とても勉強になりました！
ありがとうございました。