ADOCEを使ったサンプルプログラム

【１】コントロールの配置
２つのフォームを使います、一つはデータベースを開いていくメインページ、もう一つは選択レコードを1個だけ表示するカードページです。
メインページには上からTextBox、ListBox、ListBox、ComboBox、TextBox、ListViewControl、ボタンを７個、ラベル、CommonDialogControl FileControl を配置します。
ListViewControl と CommonDialogControl FileControl はデフォルトではツールボックスに無いので例によって登録してから使います。
上のTextBoxにはファイル名、次のListBoxにはTable名、次のListBoxにはField名、ComboBoxとTextBoxは２つでフィルタリング文字列の設定に使います。
２番目のListBoxは複数選択ができるようにプロパティーのMultiSelectを1-vbMultiSelectSimpleにします
ListViewControlに選択されたTale−Fieldのデータを一覧表示します。
ListViewControlをレポート表示として使うのでプロパティーのViewを3-lvwReportにします。
カードページにはLabelとTextBoxを５個ずつ配置します。LabelにField名、TextBoxにレコードのデータを表示します。
ADOCEを使うので、メニューからプロジェクト→参照設定で出たダイアログボックスで Microsoft CE ADO Control 3.0 もしくは 3.1 をチェックしておきます。

【２】コーディングします
(1)ファイル名の取得
コモンダイアログボックスコントロールを使用してデータベースファイル名を取得します
CommonDialog1.Filter = "Pocket Access (*.cdb) | *.cdb"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then Text1.Text = CommonDialog1.FileName
でファイル名を取得しText1.Textに保存します

(2)テーブル名の取得
ADOCEを呼び出してテーブル名を取得します
テーブル名はシステムテーブルのMSysTables内のTableNameフィールドに入っているので以下のようにして取得します
なお ADOCE_Recordset には "ADOCE.Recordset.3.0" という文字列が入っています

'Recordset Object　を作成
    Set objRecTables = CreateObject(ADOCE_Recordset)
'Text1.Text ファイルの MSysTables テーブルを開く
    objRecTables.Open "MSysTables", Text1.Text, adOpenKeyset, adLockOptimistic
    rc = objRecTables.RecordCount
    ReDim TableNameL(rc) '
'テーブル名を入手する。
    For r = 0 To rc - 1
        ss = objRecTables.Fields("TableName").Value
        'システムテーブルを除く
        'If ss <> "MSysTables" And ss <> "MSysIndexes" And ss <> "MSysFields" And ss <> "MSysProcs" Then
            TableNameL(r) = ss
            List1.AddItem ss 'ListBox1に入れる
        'End If
        objRecTables.MoveNext
    Next r
'終わったら Recordset Object を閉じて破棄する
    objRecTables.Close
    Set objRecTables = Nothing

データベースにはユーザーの作成したテーブルの他に、システムテーブルと呼ばれる次のテーブルが存在します。
MSysTables、MSysIndexes、MSysFields、MSysProcs
普通はこのテーブルを読み書きすることは無いので除いて表示しますが、ここではこのテーブルも表示するようにしています

(3)フィールド名を取得
ListBoxでユーザーが選択したテーブルに含まれるフィールド名を取得します
フィールドタイプ（文字列とか数値とか）も保存しておきます
テーブル名は''で囲んでおいたほうが良さそうです

    Set objRecFields = CreateObject(ADOCE_Recordset)
    objRecFields.Open "'" & List1.List(List1.ListIndex) & "'", Text1.Text

    ReDim FieldTypeL(objRecFields.Fields.Count)

    For r = 0 To objRecFields.Fields.Count - 1
        ss = objRecFields.Fields(r).Name 'フィールド名を入手
        List2.AddItem ss 'ListBox2に入れる
        FieldTypeL(r) = objRecFields.Fields(r).Type 'フィールドタイプを入手
    Next r

    objRecFields.Close
    Set objRecFields = Nothing

(4)ユーザーが選択したフィールド名やファイル名を保存
カードページでも使うために必要なものをPublic変数に保存しておく

DbName = Text1.Text 'ファイル名
TableName = List1.List(List1.ListIndex) 'テーブル名
FieldNumber = List2.SelCount '選択されたフィールドの数
ReDim FieldName(FieldNumber) '配列を準備
ReDim FieldType(FieldNumber)
i = 0
For j = 0 To List2.ListCount - 1 'ループでは全部調べて
    If List2.Selected(j) Then '選択されたフィールドだけ追加する
        FieldName(i) = List2.List(j)
        FieldType(i) = FieldTypeL(j) 'フィールドのタイプをコピー
        i = i + 1
    End If
Next j


(4)SQL文字列の準備
これは２つのフォームから呼ばれるのでファンクションとして標準モジュールに作成

Public Function MakeFilterString() As String
    '*******処理を書く****
    '*********************
    MakeFilterString = sstr
End Function

(注)戻り値が必要な場合はファンクションにする、戻り値はファンクション名に代入する。ちなみに戻り値がいらないならサブルーチンにする。

SQL文字列
基本は
SELECT * from 'TableName'
これだと全部選択される
フィルタリングが必要ならこの後に付け足す
SELECT * from 'TableName' WHERE FieldName LIKE '%FilterString%'
フィルタリングが複数必要なら更に付け足す
SELECT * from 'TableName' WHERE FieldName1 LIKE '%FilterString1%' AND FieldName2 LIKE '%FilterString2%'
%はワイルドカードなので %FilterString% とした場合は FilterString をどこかに含んでいれば選択される
完全に一致するものを選択したければ
SELECT * from 'TableName' WHERE FieldName = 'FilterString'


(5)レコードのデータを取得してListViewControlに表示する
'ListViewControlの準備
ListViewCtrl1.ColumnHeaders.Clear 'ListViewCtrl1をクリアここではヘッダをクリア
ListViewCtrl1.ListItems.Clear 'ここではItemをクリア、２つ必要
For j = 0 To FieldNumber - 1 'カラムヘッダを設定
    ListViewCtrl1.ColumnHeaders.Add , FieldName(j), FieldName(j), ListViewCtrl1.Width / 4
Next j
'Recordset Object　を作成
Set objRecSet = CreateObject(ADOCE_Recordset)
objRecSet.Open MakeFilterString, DbName
'データを得るループ
Do While Not objRecSet.EOF 'レコードが無くなるまでループ
    For j = 0 To FieldNumber - 1 '選択フールドの数だけループ
        sstr = objRecSet.Fields(FieldName(j)).Value
        If TypeName(sstr) = "Null" Then sstr = "" 'ListViewCtrlにNullを入れるとエラーになるので""にする
        'ListViewControlにデータを追加していく
        If j = 0 Then '最初はItemになる
            Set itemTemp = ListViewCtrl1.ListItems.Add(, , sstr)
        Else '2個目以降はSubItem
            itemTemp.SubItems(j) = sstr
        End If
    Next j
    objRecSet.MoveNext
Loop

'終了処理
objRecSet.Close
Set objRecSet = Nothing

(6)ListViewControlのItemが押されたらカードページに飛ぶ
ListViewControlのItemが押されると ListViewCtrl_ItemClick() が呼ばれるので

Private Sub ListViewCtrl1_ItemClick(ByVal Index As Long)
  SelRecord = Index '選択されているItem番号を保存して
  TestCardForm.Show 'カードページを表示する
  Test1Form.Hide
End Sub

(7)カードページを表示する
カードページが表示される時に必ず呼ばれるルーチンに処理を書く
ここでは Form_Activate() に記載
Form_Load() は最初の１回しか呼ばれないので不適切

Private Sub Form_Activate()
Dim i, fnmx
'コントロールを５個しか配置していないので５個以上は無視する
If FieldNumber > 5 Then
    fnmx = 5
Else
    fnmx = FieldNumber
End If
For i = 0 To fnmx - 1
    LabelArray(i).Caption = FieldName(i) 'ラベルにフィールド名を入れる、ラベル名は配列にいれてある
Next i

DispFieldData '選択レコードをTextBoxに表示するサブルーチンを呼ぶ

End Sub

(8)カードページにデータを表示するサブルーチン
同じSQL文字列でフィルタリングすれば同じ場所に同じデータがあることを前提として処理
本当は同じSQL文字列でフィルタリングしても同じになるとは限らないが１人で使う分には問題なさそう

'Recordset Object　を作成
Set objRecSet = CreateObject(ADOCE_Recordset)
objRecSet.Open MakeFilterString, DbName
'５個以上は無視する
If FieldNumber > 5 Then
    fnmx = 5
Else
    fnmx = FieldNumber
End If

objRecSet.Move SelRecord - 1 'レコードのNoを進める、ListViweControlのIndexは１から始まるので注意、１引かないとずれる
For i = 0 To fnmx - 1
    sstr = objRecSet.Fields(FieldName(i)).Value
    If TypeName(sstr) = "Null" Then sstr = "" 'データが無かった時の処理
    TextArray(i).Text = sstr 'TextBox名は配列に入れてある
Next i
'終了処理
objRecSet.Close
Set objRecSet = Nothing

(9)選択レコードをテキストファイル(CSVﾌｧｲﾙ)に出力するルーチン
'CommonDialogを使ってファイル名を得る、キャンセルボタンを押された時は処理を終了するために、エラーを処理する
CommonDialog1.Filter = "CSV File (*.csv) | *.csv | Text File (*.txt) | *.txt"
On Error Resume Next 'キャンセルボタンをトラップするため
CommonDialog1.CancelError = True
CommonDialog1.ShowSave
If Err.Number = 32755 Then Exit Sub 'キャンセルが押されたので抜ける
On Error GoTo 0

'実際の処理はここから
If CommonDialog1.FileName <> "" Then
  buff = CommonDialog1.FileName
  yn = MsgBox("ﾌｧｲﾙの１行目にフィールド名をつけますか？", vbYesNo, "adoce_test")
'メッセージボックスの戻り値で処理を分けるため、ynに保存しておく
  File1.Open buff, 2 '書き込みモードでOPEN
    If yn = vbYes Then '「Yes」を押したので１行目にフィールド名をつける
      buff2 = ""
      For j = 0 To FieldNumber - 1 '選択フールドの数だけループ
        buff2 = buff2 & Chr(&H22) & FieldName(j) & Chr(&H22) & ","
      Next j
      buff2 = Mid(buff2, 1, Len(buff2) - 1) '最後の","をとる
      File1.LinePrint buff2
    End If
    'Recordset Object　を作成
    Set objRecSet = CreateObject(ADOCE_Recordset)
    objRecSet.Open MakeFilterString, DbName
    'データを得るループ
    Do While Not objRecSet.EOF 'レコードが無くなるまでループ
      buff2 = "" '保存用の文字列を初期化する
      For j = 0 To FieldNumber - 1 '選択フールドの数だけループ
        sstr = objRecSet.Fields(FieldName(j)).Value '読み込む
        If TypeName(sstr) = "Null" Then sstr = "" 'Nullを入れるとエラーになるので
        buff2 = buff2 & Chr(&H22) & sstr & Chr(&H22) & "," '１フィールドづつBuff2に継ぎ足していく 文字列を""で囲んで,を付ける Chr(&H22)は「"」
      Next j
      buff2 = Mid(buff2, 1, Len(buff2) - 1) '最後の","をとる
      File1.LinePrint buff2 '１行まとめてファイルに書き出す
      objRecSet.MoveNext '次のレコードに移る
    Loop
    objRecSet.Close 'ADOCEのレコードセットを閉じる
    Set objRecSet = Nothing
  File1.Close 'ファイルを閉じる
End If

(10)全リスト
テキストファイルです

(11)ソースファイル
ZIPファイルです
インスツール用のCABは上げていません、使ってみたい方はソース内のadoc_test1.vbをデバイスに転送して使ってください、公開版のデータベースビュアーがインスツールされていれば必要なランタイムはすべて入っているはずなので動作可能です。

実行時

このソフトを作ったわけ
最初データベースビュアーを作成していて、データはWindows用のAccessで作成した物を転送して使うことにしていました。
自分で使う分には構わないのですが、一度Accessにデータを移さないといけないし、その前にAccessを持っていない人も多いはずなので、比較的多くのソフトが対応していると思われるCSVファイルを変換できるようにしました。

CSVファイルとは？
ここで扱えるのは、改行が１レコードの終わりで「，」が区切り、各データは「”」で囲んであるテキストファイルです。拡張子はtxtかcsvにして下さい。
例
"111","222","333","444"
"555","666","777","888"
"aaa","bbb","ccc","ddd"

「”」の無いものも読み込み可能です
例
111,222,333,444
555,666,777,888
aaa,bbb,ccc,ddd

ただし、この場合は文字列の中に改行が入っていると正しく変換されません

CDBファイルとは？
WindowsCEのソフトPocket Access 用のデータベースファイルです
PocketPCにはPocket Access は入っていませんが、ADOCEを用いたデータベースビュアーで見る事ができます。またUSBクレドールを通してWindowsに転送すると自動的にWindows 用のAccessのファイルに変換されます。同様にWindows用のAccessのファイルをPocketPCに転送するとCDBファイルに変換されます。

コーディング
CSVファイルの読み込みはごちゃごちゃしているので省略、データベースファイルの作成と書込のみ

'データベースファイルを作成する　Text4.Textにファイル名(パス)が入っている
'ADOCE_Recordsetには"ADOCE.Recordset.3.0"の文字列が入っている
Set rs = CreateObject(ADOCE_Recordset)
rs.Open "CREATE DATABASE '" & Text4.Text & "'"
Set rs = Nothing '閉じる
'テーブルの作成　Text5.Textにテーブル名が入っている
If Text5.Text <> "" Then 'テーブル名の作成
  table_name = Text5.Text
Else
  table_name = "table1"
End If
'フィールド文字列の作成
'フィールド名 フィールドタイプ，フィールド名 フィールドタイプ，の繰り返しになる
'field_name(i)にフィールド名の文字列が　field_type(i)にフィールドタイプのフラグが入っている
'フィールドタイプは面倒なので全部文字列、２５５文字以下はvarchar(255)それ以上はText
buff = ""
For i = 0 To maxh 'フィールド設定文字列の作成
  If field_name(i) <> "" Then 'フィールド名が設定してある
    If field_type(i) = 0 Then '短い文字列
      buff = buff & "'" & field_name(i) & "' varchar(255), "
    Else '長い文字列
      buff = buff & "'" & field_name(i) & "' Text, "
    End If
  Else 'フィールド名が設定してない時は自動的に"field0"から順に付ける
    If field_type(i) = 0 Then '短い文字列
      buff = buff & "field" & i & " varchar(255), "
    Else '長い文字列
      buff = buff & "field" & i & " Text, "
    End If
  End If
Next i
buff = Mid(buff, 1, Len(buff) - 2) '最後の", "を取る
'データベースに接続してテーブルを作成
Set rs = CreateObject(ADOCE_Recordset)
rs.Open "CREATE TABLE '" & table_name & "' (" & buff & ")", Text4.Text
Set rs = Nothing '閉じる
'レコードを書き込む
Set rec_set = CreateObject(ADOCE_Recordset)
rec_set.Open "SELECT * from '" & table_name & "'", Text4.Text, adOpenKeyset, adLockOptimistic '全レコードを選択、書込可能モード
test_load3 (2) 'ファイルを読み込んで保存するルーチンを呼ぶ
Set rs = Nothing '閉じる

'保存するルーチン、主要部分のみ
'この前にすでにbuff_Aの配列にデータが読み込まれている
rec_set.AddNew '空のレコードを作製する
For i = 0 To maxh 'フィールドの数だけループ
  rec_set(i) = buff_A(i) 'データを追加する
  'rec_set(i)の部分はrec_set(フィールド名)かrec_set(フィールド名).Valueでも可、rec_set(i)だとフィールド名が分からなくてもいいので楽
Next i
rec_set.Update 'これが無いと実際に書き込まれない


Basicで文字列処理をすると処理速度が気になります、院内薬品集を作った時のファイルで試してみました。
y.csv 34フィールド 17570レコード 3.88MB １７分２３秒
drug_dic.csv 6フィールド 7143レコード 2.52MB ３分５６秒
院内薬.csv 5フィールド 959レコード 375KB ０分２０秒
データ変換なんてそんなにしょっちゅうやるものでもないし、まあ許容範囲でしょうか、もっと良い方法をご存知の方教えてください。
メモリーの空き容量によっては大きなファイルは変換できないこともあります。

全リスト
テキストファイルです
ソースファイル
ZIPファイルです
インスツール用のCABは上げていません、使ってみたい方はソース内のcsv2cdb.vbをデバイスに転送して使ってください、公開版のデータベースビュアーがインスツールされていれば必要なランタイムはすべて入っているはずなので動作可能です。

実行時



VBTOPに戻る