Accessお手本データベースのホームへ戻る

SQLを実行して結果を表示するお手本データベース

 

図7-2-1　SQLを実行して結果を表示するサンプルデータベース

 

このサンプルデータベースは、Access のフォームから直接SQLコマンドを入力して、結果をリストボックス上に表示します。このサンプルデータベースを使用すると、Access のクエリでサポートしていないSQLをテストすることができます。

 

SQLのテキストボックスに、テストしたいSQLコマンドを入力したら、実行ボタン（！）をクリックして実行させます。SQLの実行結果は、Resultsのリストボックスに表示されます。Messageのテキストボックスには、ステータスが表示されます。

 

SQLのテキストボックスに入力したコマンドを保存するには、Queryのコンボボックスにクエリ名を入力して保存ボタンをクリックします。クエリ名が既に存在するときは置換、存在しないときは新規登録します。

 

このサンプルデータベースには、Access のアプリケーション開発で利用すると便利な１１個のサンプルクエリが登録されています。

 

表7-2-1　サンプルデータベースに登録されているクエリの一覧

サンプルデータベースに登録されているクエリ

①受注データから受注金額ベスト１０の得意先を表示するには(TOPの使い方)

②テーブルの一覧を表示するSQL

③平均単価以上の商品のみ表示するには（SubQuery の使い方）

④商品の一覧を表示するとき注文の有無も同時に表示するには（SubQuery EXISTSの使い方）

⑤今まで注文のあった得意先のみ抽出するには（Subquery EXISTSの使い方）

⑥一度も注文のなかった得意先を抽出するには（Subquery NOT EXISTSの使い方）

⑦過去４年間注文のなかった得意先を抽出するには（Subquery　NOT INの使い方）

⑧注文件数が５件以上の得意先を抽出するには（Subquery INの使い方）

⑨得意先と仕入れ先を併合して名寄せするには（UNION, DISTINCTの使い方）

⑩クロス集計の列見出しを制約するには（Crosstab Queriesの使い方）

⑪クロス集計に合計の行見出しを追加するには（Crosstab Queriesの使い方）

 

このサンプルデータベース（CH7-2.mdb）では、以下のノウハウを習得することができます。

 

◆　ADOオブジェクトのOpen/Close/AddNew/Update/Seekメソッドの使い方

◆　メモ型/ロングバイナリ型のフィールドからGetChunkメソッドでデータを取得する方法

◆　リストボックスの値集合タイプにユーザー定義関数を指定して値集合ソースを作成する方法

◆　フォームにホットキー(Ctrl + E)を登録する方法

◆　リンクテーブルが壊れていないか調べて、自動的に再リンクする方法

◆　Windowsのコモンダイアログを表示する方法

 

●　サンプルデータベースで使用するテーブルを準備するには

 

１　Accessを起動したら作業フォルダに、新規データベース CH7-2.mdbを作成します。

 

２　メニューから外部データベースの取り込み、テーブルのリンクをクリックします。リンクのダイアログが表示されたら、Accessのサンプルデータベース Northwind.mdbを選択してリンクボタンをクリックします。（Northwind.mdbは、デフォルトでは”C:\Program Files\Microsoft Office\Office\Samples”にインストールされます。）

 

３　テーブルのリンクのダイアログが表示されたら、すべて選択のボタンをクリックします。最後に、OKボタンをクリックしてリンクを完了させます。

 

図7-2-2　Northwind.mdbの全てのテーブルをリンクさせる

 

４　メニューから外部データの取り込み、インポートをクリックしたらCH7-2.mdbからtblSQLをインポートします。tblSQLには、１１個のサンプルSQLが登録されています。

 

表7-2-2　tblSQLに登録されているサンプルSQL

No

SQLのサンプル

１

受注データから受注金額ベスト１０の得意先を表示するには(TOPの使い方)

SELECT TOP 10 得意先.得意先名, Sum([単価]*[数量]) AS 受注金額

FROM (得意先 INNER JOIN 受注 ON 得意先.得意先コード = 受注.得意先コード)

INNER JOIN 受注明細 ON 受注.受注コード = 受注明細.受注コード

GROUP BY 得意先.得意先名

ORDER BY Sum([単価]*[数量]) DESC;

２

テーブルの一覧を表示するSQL

SELECT MSysObjects.Name FROM MsysObjects

WHERE (Left([Name],1)<>"~") AND (Left([Name],4) <> "Msys") AND 

((MSysObjects.Type)=1 OR (MSysObjects.Type)=6)

ORDER BY MSysObjects.Name;

３

平均単価以上の商品のみ表示するには（SubQuery の使い方）

SELECT 商品コード, 商品名, 単価, (SELECT AVG(単価) FROM 商品) AS 平均単価

FROM 商品

WHERE 単価 > (SELECT AVG(単価) FROM 商品);

４

商品の一覧を表示するとき注文の有無も同時に表示するには（SubQuery EXISTSの使い方）

SELECT 商品.商品コード, 商品.商品名,

Iif(Exists (SELECT * FROM 受注明細

WHERE 商品コード = 商品.商品コード),"有","無") AS 注文有無

FROM 商品

ORDER BY 商品.商品コード;

５

今まで注文のあった得意先のみ抽出するには（Subquery EXISTSの使い方）

SELECT 得意先.得意先コード, 得意先.得意先名

FROM 得意先

WHERE EXISTS (SELECT * FROM 受注 WHERE

受注.得意先コード=得意先.得意先コード);

６

一度も注文のなかった得意先を抽出するには（Subquery NOT EXISTSの使い方）

SELECT 得意先.得意先コード, 得意先.得意先名

FROM 得意先

WHERE NOT EXISTS (SELECT * FROM 受注 WHERE

受注.得意先コード=得意先.得意先コード);

７

過去４年間注文のなかった得意先を抽出するには（Subquery　NOT INの使い方）

SELECT 得意先.得意先コード, 得意先.得意先名

FROM 得意先

WHERE 得意先.得意先コード NOT IN

(SELECT 受注.得意先コード FROM 受注 WHERE

受注.受注日 > DateAdd('yyyy',-4,Date()));

８

注文件数が５件以上の得意先を抽出するには（Subquery INの使い方）

SELECT 得意先.得意先コード, 得意先.得意先名

FROM 得意先

WHERE 得意先コード IN

(SELECT 受注.得意先コード

FROM 受注

GROUP BY 受注.得意先コード

HAVING (Count(*) > 5));

９

得意先と仕入れ先を併合して名寄せするには（UNION, DISTINCTの使い方）

SELECT DISTINCT 得意先.得意先名, 得意先.郵便番号,

得意先.都道府県, 得意先.住所1, 得意先.住所2, 得意先.電話番号

FROM 得意先

UNION

SELECT 仕入先.仕入先名, 仕入先.郵便番号,

仕入先.都道府県, 仕入先.住所1, 仕入先.住所2, 仕入先.電話番号

FROM 仕入先;

10

クロス集計の列見出しを制約するには（Crosstab Queriesの使い方）

TRANSFORM Sum([単価]*[数量]) AS 売上高

SELECT 得意先.得意先名

FROM (得意先 INNER JOIN 受注 ON 得意先.得意先コード = 受注.得意先コード) 

INNER JOIN 受注明細 ON 受注.受注コード = 受注明細.受注コード

WHERE (((受注.受注日) Between #1/1/96# And #12/31/96#))

GROUP BY 得意先.得意先名

PIVOT Format([受注日],"yy/mm") IN ("96/01","96/03","96/05","96/07");

11

クロス集計に合計の行見出しを追加するには（Crosstab Queriesの使い方）

TRANSFORM Sum([単価]*[数量]) AS 売上高

SELECT 得意先.得意先名, Sum([単価]*[数量]) AS 年間売上高

FROM (得意先 INNER JOIN 受注 ON 得意先.得意先コード = 受注.得意先コード) 

INNER JOIN 受注明細 ON 受注.受注コード = 受注明細.受注コード

WHERE (((受注.受注日) Between #1/1/96# And #12/31/96#))

GROUP BY 得意先.得意先名

PIVOT Format([受注日],"yy/mm");

 

表7-2-3 tblSQLテーブルの構造

テーブル名

説　　　明

作成日

最終更新日

tblSQL

SQLコマンドを保存します

　

　

No

フィールド名

データ型

サイズ

説　　　　明

1

ID

オートナンバー型

4

主キー設定

2

QueryName

テキスト型

255

　

3

QueryCmd

メモ型

0

　

 

５　テーブルの準備ができたらAccess を終了させます。

 

 

●　SQLを実行して結果を表示するフォームを作成するには

 

１　Access を起動したら、作業フォルダに作成したCH7-2.mdbを開きます。

 

２　データベースウィンドウからフォームをクリックしたら、一覧からデザインビューでフォームを作成するをダブルクリックします。フォームのデザインビューが表示されたら、ツールボックスを表示させます。

 

３　ツールボックスからコンボボックスのアイコンをクリックしたら、フォーム詳細の上位に配置します。このコンボボックスQueryには、クエリ名を表示させます。

 

４　ツールボックスからラベルのアイコンをクリックしたら、コンボボックスQueryの下に配置して、標題に“入力したSQLを登録するにはコンボボックスに新規クエリ名を入力してください！”を入力します。

 

５　ツールボックスからテキストボックスのアイコンをクリックしたら、ラベルの下に配置してテキストボックスSQLを作成します。テキストボックスを選択してサイズハンドラーを表示させたら、マウスをサイズハンドラーに移動させてコントロールの高さを３cmぐらいに調整します。

 

６　ツールボックスからリストボックスのアイコンをクリックしたら、テキストボックスSQLの下に配置して、コントロールの高さを4cmぐらいに調整します。このリストボックスには、SQLの実行結果を表示します。リストボックスの値集合タイプ、値集合ソースは、実行時に設定します。

 

７　ツールボックスからテキストボックスのアイコンをクリックしたら、リストボックスの下にテキストボックスMessageを配置して、コントロールの高さを1.3cmぐらいに調整します。

８　ツールボックスからコマンドボタンのアイコンをクリックしたら、コンボボックスQueryの右に３個のボタン（左から順番に実行、保存、閉じる）を作成します。

 

９　このフォームには、ホットキー(Ctrl + E)を登録しますのでフォームのプロパティを表示させたら、キーボードイベント取得を“はい”に設定します。

 

フォームに作成したコントロールのプロパティは、表7-2-4のように設定します。

 

表7-2-4　フォームに作成したコントロールのプロパティ

コントロールの種類

プロパティ

値

コンボボックス

名前

cboQuery

値集合タイプ

テーブル/クエリ

値集合ソース

SELECT tblSQL.ID, tblSQL.QueryName

FROM tblSQL;

連結列

1

列数

2

列幅

0cm;7.7cm

入力チェック

はい

テキストボックス１

名前

txtSQL

高さ

3cm

リストボックス

名前

lboResults

高さ

4cm

値集合タイプ

実行時設定

値集合ソース

実行時設定

テキストボックス２

名前

txtMessage

高さ

1.3cm

背景色

12632256

立体表示

くぼみ

コマンドボタン１

名前

cmdRunSQL

コマンドボタン２

名前

cmdSave

コマンドボタン３

名前

cmdClose

フォーム

キーボードイベント取得

はい

 

図7-2-3　SQLの実行結果を表示するフォームのレイアウト

 

１０　メニューからコードのアイコンをクリックしたら、フォームモジュールを表示させます。CH7-2.mdbを開いたら、frmSQLBuilderのフォームモジュールをコピーして貼り付けます。フォームモジュールのソースコードは、リスト7-2-1を参照してください。CH7-2.mdbからモジュールbasLinkedTables, basMyLib, basWindowsCommonDialogをコピーします。これらのモジュールは、フォームモジュールから参照します。これらのモジュールは、Microsoft DAO 3.6 Object Library, Microsoft ADO Ext. 2.x for DDL and Secrityのライブラリを参照しますので、VBEのツールメニューから参照設定をクリックして登録してください。

 

１１　フォームをビューモードに切り替えたら、Queryのコンボボックスから“⑤今まで注文のあった得意先のみ抽出するには（Subquey Existsの使い方）”を選択して、実行ボタンをクリックします。リストボックスには、今まで注文のあった得意先コードと得意先名が表示されます。Messageのテキストボックスには、ステータスが表示されます。

 

図7-2-4　今まで注文のあった得意先のみ抽出するためのSQLを実行した結果

 

１２　フォームをfrmSQLBuilderの名称で保存してAccess を終了させます。

 

 

Form_Open()イベント処理

このイベントは、フォームが開かれたとき発生します。このイベントでは、VerifyLinks_FS()関数を使用して、リンクテーブルのリンクが壊れていないか調べます。リンクが壊れているときは、自動的に再リンクします。

 

 

Form_Load()イベント処理

このイベントは、フォームが開かれてデータをロードするときに発生します。このイベントでは、モジュールレベルのメモリ変数を初期化します。

 

 

Form_KeyDown()イベント処理

このイベントは、キーボードから任意のキーを押下したときに発生します。このイベントでは、フォームにホットキー(Ctrl + E)を設定します。フォーム上から、Ctrl+Eを押下すると、実行ボタンをクリックしたときと同じ処理を行います。

 

 

cmdClose_Click()イベント処理

このイベントは、フォームから閉じるのコマンドボタンをクリックしたときに発生します。このイベントでは、DoCmdのCloseメソッドでフォームを閉じます。

 

 

cmdRunSQL_Click()イベント処理

このイベントは、フォームから実行のコマンドボタンをクリックしたときに発生します。このイベントでは、サブプロシージャExecuteSQLを呼び出して、SQLを実行します。

 

 

cmdSave_Click()イベント処理

このイベントは、フォームから保存のコマンドボタンをクリックしたときに発生します。このイベントでは、フォームに入力したSQLコマンドをtblSQLに保存します。ADOオブジェクトのOpenメソッドでtblSQLを開いたら、Seekメソッドで既に登録されているレコードを検索します。フィールドQueryCmdに、フォーム上のSQLコマンドを格納したら、Updateメソッドでレコードを更新します。

 

  Set rs = New ADODB.Recordset

  With rs

    .Index = "PrimaryKey"

    .Open "tblSQL", _

      CurrentProject.Connection, _

      adOpenKeyset, _

      adLockOptimistic, _

      adCmdTableDirect

    .Seek Me.cboQuery, adSeekFirstEQ

    !QueryCmd = Trim(Me.txtSQL.Value)

    .Update

    .Close

  End With

  Set rs = Nothing

 

 

cboQuery_AfterUpdate()イベント処理

このイベントは、Queryのコンボボックスからクエリを選択したときに発生します。このイベントでは、tblSQLを検索して、テーブルに登録されているSQLコマンドを表示します。strSQLに、コンボボックスで選択したクエリを検索するSQLコマンドを格納したら、ADOのOpenメソッドでレコードセットを開きます。レコードが見つかったら、フィールドQueryCmdのActualSizeプロパティを参照してSQLコマンドのサイズを取得します。フィールドのGetChunkメソッドで、SQLコマンドを取得したらフォームに表示します。

 

  Set rs = New ADODB.Recordset

  With rs

    .Open strSQL, CurrentProject.Connection, _

      adOpenStatic, adLockReadOnly, adCmdText

    If Not .EOF Then

      lngSize = rs(0).ActualSize

      Me.txtSQL = Trim(rs(0).GetChunk(lngSize))

    End If

    .Close

  End With

  Set rs = Nothing

 

Tip

フィールドのデータ型がメモ型やロングバイナリー型のときは、GetChunkメソッドを使用してデータを取得します。GetChunkメソッドでデータを分割して取得したときは、AppendChunkメソッドで結合します。

 

 

cboQuery_NotInList()イベント処理

このイベントは、Queryのコンボボックスに新規のクエリ名を入力したときに発生します。このイベントでは、新規入力したクエリをtblSQLに追加します。ADOオブジェクトのOpenメソッドでtblSQLを開いたら、AddNewメソッドで新規レコードを追加します。QueryName、QueryCmdにデータを格納したら、Updateメソッドでレコードを更新します。レコードを新規に追加したときは、引数ResponseにacDataErrAddedを設定して戻ります。レコードの追加を中止したときは、ResponseにacDataErrDisplayを設定して戻ります。この場合、Accessからエラーメッセージが表示されます。

 

  Set rs = New ADODB.Recordset

  With rs

    .Open _

      Source:="tblSQL", _

      ActiveConnection:=CurrentProject.Connection, _

      CursorType:=adOpenKeyset, _

      LockType:=adLockOptimistic, _

      Options:=adCmdTableDirect

    .AddNew

      !QueryName = NewData

      !QueryCmd = Trim(Me.txtSQL.Value)

    .Update

    .Close

  End With

  Set rs = Nothing

 

 

ExecuteSQL()

このプロシージャは、SQLの実行ボタンをクリックしたときに呼ばれます。このプロシージャでは、リストボックスの値集合タイプ(RowSourceType)にユーザー定義関数FillResultListを設定して、リストボックスにSQLの結果を表示させます。値集合タイプに関数名を設定すると、その関数が実行されます。

 

 

FillResultList()関数

この関数は、リストボックスの値集合タイプに設定されていて、リストボックスを再クエリしたときに呼ばれます。この関数は、Select Case varCode….End Selectで、引数varCodeの値に対応した処理を行います。引数がacLBInitialize条件のときは、BuildRecordset()関数を呼び出して、レコードセットの内容を配列変数に格納します。acLBGetRowCount条件のときは、レコード件数を返します。acLBGetColumnCount条件のときは、レコードのフィールド数を返します。acLBGetValue条件のときは、配列変数savarData()からレコードの内容を返します。acLBEnd条件のときは、配列変数savarDataを解放します。

 

  Select Case varCode

  Case acLBInitialize

    If mintQueryRun = 0 Then

      varRetval = BuildRecordset(savarData(), slngRows, sintCols)

    Else

      varRetval = True

    End If

    mintQueryRun = mintQueryRun + 1

  Case acLBOpen

    varRetval = Timer

  Case acLBGetRowCount

    If slngRows = 0 Then

      varRetval = 0

    Else

      varRetval = slngRows + 1

    End If

  Case acLBGetColumnCount

    varRetval = sintCols

  Case acLBGetColumnWidth

    varRetval = -1

  Case acLBGetValue

    varRetval = savarData(varRow, varCol)

  Case acLBGetFormat

    varRetval = -1

  Case acLBEnd

    If mintQueryRun > 1 Then

      Erase savarData

      slngRows = 0

      sintCols = 0

    End If

  End Select

 

 

BuildRecordset()関数

この関数は、フォームに入力したSQLコマンドを実行してレコードセットの内容、レコード件数、フィールド数を返します。ADOオブジェクトのOpenメソッドで、レコードセットを開きます。（OpenメソッドのSourceには、フォームから入力したSQLコマンドを指定します。）

 

    .Open _

      Source:=Trim(Me.txtSQL.Value), _

      ActiveConnection:=CurrentProject.Connection, _

      CursorType:=adOpenStatic, _

      LockType:=adLockReadOnly, _

      Options:=adCmdText

 

レコードセットが正常にオープンされたら、レコード件数とフィールド数を引数に設定します。

 

      intCols = .Fields.Count

      lngRows = .RecordCount

 

ReDimで配列変数avarData()を再定義したら、For….Nextループでレコードセットのフィールド名を配列変数に格納します。配列変数avarDataは、二次元の配列で要素１には、レコード番号、要素２には、フィールド名/フィールド値が格納されます。

 

      ReDim avarData(0 To lngRows, 0 To intCols - 1)

      For intCol = 0 To intCols - 1

        avarData(0, intCol) = .Fields(intCol).Name

      Next intCol

 

Do Until .EOF….Loopでは、全てのレコードのフィールド値を配列変数に格納します。フィールドの型がロングバイナリー型のときは、”OLE Value”を格納します。

 

      Do Until .EOF

        For intCol = 0 To intCols - 1

          If .Fields(intCol).Type = adLongVarBinary Then

            avarData(lngRow, intCol) = "OLE Value"

          Else

            avarData(lngRow, intCol) = .Fields(intCol)

          End If

        Next intCol

        lngRow = lngRow + 1

        If lngRow > mlngMaxRows Then

          Exit Do

        End If

        .MoveNext

      Loop

 

Tip

レコードセットの内容を配列変数に格納するには、レコードセットオブジェクトのGetRowsメソッドを使用すると便利です。GetRowsメソッドで使用する配列変数は二次元で、要素１にはフィールド値、要素２にはレコード番号が格納されます。

 

GetRowsメソッドでは、メモ型やロングバイナー型のフィールド値も配列変数に格納されますので注意する必要があります。

 

サンプルデータベースでは、ロングバイナリー型のデータを取得する必要がないので“OLE Value”を格納しています。

 

 

リスト　7-2-1　frmSQLBuilderのソースコード

Option Compare Database

Option Explicit

 

Private mlngMaxRows As Long

Private mintQueryRun As Integer

 

Private Function BuildRecordset(avarData() As Variant, _

  lngRows As Long, intCols As Integer) As Boolean

 

  Dim rs As ADODB.Recordset

  Dim lngRow As Long

  Dim intCol As Integer

  Dim strMsg As String

 

  On Error GoTo Err_BuildRecordset

 

  BuildRecordset = False

 

  If IsNull(Me.txtSQL) Then

    Exit Function

  End If

   

  With Me

    .txtMessage = "Running query..."

    .Repaint

  End With

 

  On Error Resume Next

  Set rs = New ADODB.Recordset

  With rs

    .Open _

      Source:=Trim(Me.txtSQL.Value), _

      ActiveConnection:=CurrentProject.Connection, _

      CursorType:=adOpenStatic, _

      LockType:=adLockReadOnly, _

      Options:=adCmdText

   

    If Err <> 0 Then

      strMsg = "Error " & Err.Number & ": " & Err.Description

      Select Case Err

      Case -2147217865

        strMsg = strMsg & vbCrLf & _

        "【このｴﾗｰは、SQLのﾃｰﾌﾞﾙ名を誤入力したときに発生します】"

     

      Case -2147217904

        strMsg = strMsg & vbCrLf & _

        "【このｴﾗｰは、SQLのﾌｨｰﾙﾄﾞ名を誤入力したときに発生します】"

 

      Case -2147217900

        strMsg = strMsg & vbCrLf & _

        "【このｴﾗｰは、不当なSQL文を入力したときに発生します】"

     

      Case Else

        ' Do nothing

      End Select

       

      On Error GoTo Err_BuildRecordset

      intCols = 0

      lngRows = 0

      

    Else  ' No Errors

      On Error GoTo Err_BuildRecordset

      If Not .EOF Then

        .MoveLast

      End If

      intCols = .Fields.Count

      lngRows = .RecordCount

 

      If lngRows <= mlngMaxRows Then

        strMsg = "Query executed... " & lngRows & " rows returned."

      End If

 

      ReDim avarData(0 To lngRows, 0 To intCols - 1)

 

      For intCol = 0 To intCols - 1

        avarData(0, intCol) = .Fields(intCol).Name

      Next intCol

 

      If Not .EOF Then

        .MoveFirst

      End If

      lngRow = 1

 

      Do Until .EOF

        For intCol = 0 To intCols - 1

          If .Fields(intCol).Type = adLongVarBinary Then

            avarData(lngRow, intCol) = "OLE Value"

          Else

            avarData(lngRow, intCol) = .Fields(intCol)

          End If

        Next intCol

        lngRow = lngRow + 1

        If lngRow > mlngMaxRows Then

          Exit Do

        End If

        .MoveNext

      Loop

      .Close

      BuildRecordset = True

    End If  ' Err <> 0

  End With

  Set rs = Nothing

  Me.txtMessage = strMsg

 

Exit_BuildRecordset:

  On Error GoTo 0

  Exit Function

 

Err_BuildRecordset:

  Select Case Err

  Case Else

    MsgBox "Error#" & Err.Number & ": " & Err.Description, _

      vbOKOnly + vbCritical, "SQL Builder BuildRecordset"

  End Select

  Resume Exit_BuildRecordset

 

End Function

 

Private Sub cboQuery_AfterUpdate()

 

  Dim rs As ADODB.Recordset

  Dim lngSize As Long

  Dim strSQL As String

 

  strSQL = "SELECT tblSQL.QueryCmd" & _

    " FROM tblSQL" & _

    " WHERE (((tblSQL.ID)=" & Me.cboQuery & "));"

   

  Set rs = New ADODB.Recordset

  With rs

    .Open strSQL, CurrentProject.Connection, _

adOpenStatic, adLockReadOnly, adCmdText

    If Not .EOF Then

      lngSize = rs(0).ActualSize

      Me.txtSQL = Trim(rs(0).GetChunk(lngSize))

    End If

    .Close

  End With

  Set rs = Nothing

   

End Sub

 

Private Sub cboQuery_NotInList(NewData As String, _

Response As Integer)

 

  Dim rs As ADODB.Recordset

  Dim strMsg As String

 

  strMsg = "表示されているSQLを" & vbCrLf & _

    "<" & NewData & ">" & vbCrLf & _

    "の名称で新規登録してよろしいですか？"

  If MsgBox(strMsg, vbYesNo + vbQuestion) = vbNo Then

    Response = acDataErrDisplay

    Exit Sub

  End If

 

  Set rs = New ADODB.Recordset

  With rs

    .Open _

      Source:="tblSQL", _

      ActiveConnection:=CurrentProject.Connection, _

      CursorType:=adOpenKeyset, _

      LockType:=adLockOptimistic, _

      Options:=adCmdTableDirect

    .AddNew

      !QueryName = NewData

      !QueryCmd = Trim(Me.txtSQL.Value)

    .Update

    .Close

  End With

  Set rs = Nothing

  Response = acDataErrAdded

 

End Sub

 

Private Sub cmdClose_Click()

  DoCmd.Close

'  DoCmd.Quit acQuitSaveAll

End Sub

 

Private Sub cmdRunSQL_Click()

  Call ExecuteSQL

End Sub

 

Private Sub ExecuteSQL()

 

  On Error GoTo Err_ExecuteSQL

 

  Dim lngRecs As Long

  Dim varSQL As Variant

  Dim ctlResults As Control

 

  mintQueryRun = 0

 

  Set ctlResults = Me.lboResults

   

  varSQL = Me.txtSQL

 

  If Not IsNull(varSQL) Then

    ctlResults.RowSourceType = "FillResultList"

  End If

 

Exit_ExecuteSQL:

  On Error GoTo 0

  Exit Sub

 

Err_ExecuteSQL:

  Select Case Err

  Case Else

    MsgBox "Error#" & Err.Number & ": " & Err.Description, _

      vbOKOnly + vbCritical, "SQL Scratchpad ExecuteSQL"

  End Select

  Resume Exit_ExecuteSQL

 

End Sub

 

Private Function FillResultList(ctl As Control, varID As Variant, _

  varRow As Variant, varCol As Variant, _

varCode As Variant) As Variant

   

  Dim intI As Integer

  Dim varRetval As Variant

  Dim strMsg As String

  Dim varSQL As Variant

   

  Static savarData() As Variant

  Static slngRows As Long

  Static sintCols As Integer

   

  varSQL = Me.txtSQL

 

  varRetval = Null

 

  Select Case varCode

  Case acLBInitialize

    If mintQueryRun = 0 Then

      varRetval = BuildRecordset(savarData(), slngRows, sintCols)

    Else

      varRetval = True

    End If

    mintQueryRun = mintQueryRun + 1

  Case acLBOpen

    varRetval = Timer

  Case acLBGetRowCount

    If slngRows = 0 Then

      varRetval = 0

    Else

      varRetval = slngRows + 1

    End If

  Case acLBGetColumnCount

    varRetval = sintCols

  Case acLBGetColumnWidth

    varRetval = -1

  Case acLBGetValue

    varRetval = savarData(varRow, varCol)

  Case acLBGetFormat

    varRetval = -1

  Case acLBEnd

    If mintQueryRun > 1 Then

      Erase savarData

      slngRows = 0

      sintCols = 0

    End If

  End Select

 

  FillResultList = varRetval

 

End Function

 

Private Sub cmdSave_Click()

  Dim rs As ADODB.Recordset

  Dim strMsg As String

 

  strMsg = "表示されているSQLを上書き保存してよろしいですか？"

  If MsgBox(strMsg, vbYesNo + vbQuestion) = vbNo Then

    Exit Sub

  End If

 

  Set rs = New ADODB.Recordset

  With rs

    .Index = "PrimaryKey"

    .Open "tblSQL", _

      CurrentProject.Connection, _

      adOpenKeyset, _

      adLockOptimistic, _

      adCmdTableDirect

    .Seek Me.cboQuery, adSeekFirstEQ

    !QueryCmd = Trim(Me.txtSQL.Value)

    .Update

    .Close

  End With

  Set rs = Nothing

 

End Sub

 

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

  If (Shift And acCtrlMask) <> 0 And KeyCode = Asc("E") Then

    Me.cmdRunSQL.SetFocus

    Call cmdRunSQL_Click

    KeyCode = 0

  End If

End Sub

 

Private Sub Form_Load()

  mlngMaxRows = 1000

End Sub

 

Private Sub Form_Open(Cancel As Integer)

  If Not VerifyLinks_FS("Northwind.mdb", "得意先") Then

    MsgBox "テーブルの再リンクに失敗しました！" & vbCrLf & _

      "Accessのリンクテーブルマネージャから” & _

” Northwind.mdb を再リンクしてください.", _

      vbCritical + vbOKOnly

  End If

End Sub

 

 

ダウンロード (CH7-2.lzh)
Accessお手本データベースのホームへ戻る