○VB6 DAO アクセスデータベースへLF区切りのCSVファイルを読み書き

db1.mdb にはTABLEというテーブルがあり、任意のフィールドがあるとします。

Command1ボタンをクリックすることにより、TABLEのフィールド名と内容を
out.csvファイルに改行文字LFで書き込みます。

Command2ボタンをクリックすることにより、CSVファイルをTABLEに読み込みます。
in.csvファイルの先頭行にはTABLEのフィールド名と同一のデータがカンマ区切りで
書かれており、改行文字はLFで２行目から値が書き込まれています。




'--------------------------------------------------------
'データベースの内容をLF区切りのCSVファイルに書き出す
'--------------------------------------------------------
Private Sub Command1_Click()
    Dim filename As String
    filename = "./out.csv"
    On Error Resume Next
    Kill filename
    On Error GoTo 0
    
    Open filename For Binary As #1
    
    '-----------初期設定---------------
    Dim MyDB As Database
    Set MyDB = OpenDatabase("./db1.mdb") 'データーベースファイルのオープン
    
    '-----------レコードセットを開く-----------
    Dim MyTable As Recordset
    Set MyTable = MyDB.OpenRecordset("select * from [TABLE]") 'SQL実行によりレコードの取得
    
    Dim i As Long
    
    'フィールド名を出力する
    Put #1, , """" & MyTable.Fields(0).Name & """"
    For i = 1 To MyTable.Fields.Count - 1
        Put #1, , ","""
        Put #1, , MyTable.Fields(i).Name
        Put #1, , """"
    Next i
    Put #1, , vbLf
    
    '値を出力する
    MyTable.MoveFirst '先頭の位置に移動
    Do While Not MyTable.EOF 'EOFになるまでループ
        If Not IsNull(MyTable.Fields(0)) Then
            Put #1, , """" & CStr(MyTable.Fields(0)) & """" '現在のレコード位置の値を表示
            For i = 1 To MyTable.Fields.Count - 1
                If Not IsNull(MyTable.Fields(i)) Then
                    Put #1, , ","""
                    Put #1, , CStr(MyTable.Fields(i)) '現在のレコード位置の値を表示
                    Put #1, , """"
                Else
                    Put #1, , ","""""
                End If
            Next i
            Put #1, , vbLf
        End If
        MyTable.MoveNext
    Loop
    
    MyTable.Close
    MyDB.Close
    Close #1
End Sub

'--------------------------------------------------------
'LF区切りのCSVファイルの内容をデータベースに書き込む
'--------------------------------------------------------
Private Sub Command2_Click()
    'LFで区切られたCSVファイルをDBに入れる
    Dim filename As String
    Dim pos As String
    Dim ar() As String
    '要素数
    Dim ar_len As Long
    Dim i As Long
    
    filename = Dir("./in.csv")
    
    Dim MyDB As Database
    Set MyDB = OpenDatabase("./db1.mdb") 'データーベースファイルのオープン、フルパスの指定が必要
    
    'レコードを削除するSQL文を実行
    Dim strSQL As String
    strSQL = ""
    strSQL = strSQL & " DELETE * FROM "
    strSQL = strSQL & "[TABLE]"
    MyDB.Execute strSQL
    'レコードセットを開く
    Dim MyTable As Recordset
    Set MyTable = MyDB.OpenRecordset("select * from [TABLE]") 'SQL実行によりレコードの取得
    
    Open filename For Binary Access Read As #1
    
    'カラム名を読み、要素数とする
    ar = Split(lineInputLF(1), ",")
    ar_len = UBound(ar)
    
    'フィールドの整合性チェック
    If (MyTable.Fields.Count - 1 <> ar_len) Then
        MsgBox ("ファイルの要素数とデータベースのフィールド数が違っています")
        End
    Else
        For i = 0 To ar_len
            If (MyTable.Fields(i).Name <> Replace(ar(i), """", "")) Then
                MsgBox ("ファイルのフィールド名とデータベースのフィールド名が一致していません")
                End
            End If
        Next i
    End If
    
    Do Until EOF(1)
        ar = Split(lineInputLF(1), ",")
        If (UBound(ar) = ar_len) Then
            '配列の長さが正しいためＤＢに登録する
            MyTable.AddNew '新しいレコードの追加
            Dim strpos As String
            For i = 0 To ar_len
                strpos = Replace(ar(i), """", "")
                If (strpos <> "") Then MyTable.Fields(i) = strpos
            Next i
            MyTable.Update 'データーベースに反映
        Else
            '配列の長さが異常である
            If (UBound(ar) > 0) Then
                '要素数が0以上のため元データの区切り文字が間違っている
                MsgBox (ar(0))
            End If
        End If
    Loop
    
    Close #1
    MyTable.Close
    MyDB.Close
End Sub

'--------------------------------------------------------
'LF区切りの一行を読み出す
'--------------------------------------------------------
Private Function lineInputLF(fileNo As Integer) As String
    Dim str As String
    Dim pos As String
    pos = String(1, " ")
    
    Do Until EOF(fileNo)
      Get #fileNo, , pos
      If pos = vbLf Then Exit Do
      str = str + pos
    Loop
    lineInputLF = str
End Function