愚者の経験

「また今度」はほとんどこない

月別アーカイブ: 11月 2011

フォームのレコードソースを利用しないメリット

Accessのテーブルへの問い合わせは
「レコードソースまたは値集合ソースが設定されているオブジェクトが読み込まれる
(フォームが開くまたはその後コンボボックスの初回のプルダウン時など)」たびに自動的に発生するので
結構無駄が多いです。お手軽ということではあるのですが…
データシートのフィルタやソートの時にも下手すれば全件取得しているのもいただけないです。
SQLServerのプロファイラーで確認したときはびっくりしました。

コードの量は当然増えるがRecordsetオブジェクトを直接代入する場合はそのようなことはないです。

    Set Forms(“フォーム1”).Recordset = rst
    Set Forms(“フォーム2”).コンボボックス1.Recordset = rst

また上記のようにRecordsetを使い回せば、フォーム1でのRecordsetの変更を
フォーム2のコンボボックスのデータに反映できます。最新のデータ表示にはRecordsetをSetしなおす必要がありますがその操作によってデータの問い合せが行われるわけではありません。

ネットワークにはかなりやさしいプログラムになる反面、作る人にとってはかなり厳しいものになります。

※注意
バッチ更新モードの場合はUpdateBatchを実行しないと「見えません」。
以下のコードではAddNewしたデータはコンボボックスに見えません。(空行にみえます。)

rst.AddNew “フィールド1”, 1000
Set Forms(“フォーム2”).コンボボックス1.Recordset = rst

しかしレコードセットの値を見るとしっかり入っています。
UpdateBatchを実行します。

rst.AddNew “フィールド1”, 1000
rst.UpdateBatch
Set Forms(“フォーム2”).コンボボックス1.Recordset = rst

結構ハマりました。

半角1、全角2の大きさで切り取るLeft関数

参考:Access Tips by pPoy様のページにある
「半角は1、全角は2として文字列の先頭から見かけのバイト数で切り取る関数」
最近このような関数が必要になる機会が多いので自分流にアレンジしました。
実行速度を追求にしたかったのでその部分は改良(デグレード?)してあります。

Access Tips by pPoy様は一文字ずつStrConvでAscii変換しつつ文字数を数えていますが
私の方はByte配列に文字列全体をAscii変換で代入します。
また、最後にスペース埋めをする処理が追加されています。

標準モジュールなどに貼付けてください。

Public Enum FillOperationEnum
RightFill
LeftFill
NotFill
End Enum

Public Function exLeft(Value As Variant, Length As Long, Optional Operation As FillOperationEnum = NotFill) As String
On Error GoTo exit1
Dim Temp() As Byte
Dim SpaceCount As Long

If Nz(Value, “”) = “” Then Exit Function

Temp = StrConv(Value, vbFromUnicode)

ReDim Preserve Temp(Length – 1)
exLeft = StrConv(Temp, vbUnicode)
SpaceCount = InStr(exLeft, Chr(0))

If SpaceCount > 0 Then
SpaceCount = Len(exLeft) – (SpaceCount – 1)
exLeft = Left$(exLeft, Len(exLeft) – SpaceCount)
Else
If Mid$(Value, Len(exLeft), 1) Right$(exLeft, 1) Then
exLeft = Left$(exLeft, Len(exLeft) – 1)
SpaceCount = 1
End If
End If

If Operation NotFill Then
If Operation = LeftFill Then
exLeft = Space$(SpaceCount) & exLeft
Else
exLeft = exLeft & Space$(SpaceCount)
End If
End If

Erase Temp
Exit Function
exit1:
exLeft = “”
End Function

実行結果は以下のようになります。
exLeft(“aaaああ”, 5) → aaaあ
exLeft(“aaaああ”, 6) → aaaあ(文字の途中で切れる場合は1バイト小さくします。)
exLeft(“aaaああ”, 9, LeftFill) →   aaaああ(Space(2) & “aaaああ”)
exLeft(“aaaああ”, 9, RightFill) → aaaああ  (”aaaああ” & Space(2))

ループしないように作ってありますので若干スピートが出ると期待してます。
検証が不十分なのでこれから色々やってみます。(特に文字切れを起こす場合のあたりが心配です。)

VBAからODBC APIを使う 実行編(改良版)

前の記事:VBAからODBC APIを使う 実行編

SQLBindColを利用した値の取得方法がわかりましたので紹介します。
改良の余地はまだあると思いますが大まかにはこれであってると思います。

接続、SQL文発行、スタンドアロンレコードセットを作成するクラスモジュールの一部。

Private Declare Function GlobalAlloc Lib “kernel32” ( _
                ByVal wFlags As Long, _
                ByVal dwBytes As Long) As Long
               
Private Declare Function GlobalFree Lib “kernel32” ( _
                ByVal hMem As Long) As Long
               
Private Declare Function GlobalLock Lib “kernel32” ( _
                ByVal hMem As Long) As Long
               
Private Declare Function GlobalUnlock Lib “kernel32” ( _
                ByVal hMem As Long) As Long
Private Const GMEM_MOVEABLE = &H2
Private Declare Sub CopyMemory Lib “kernel32” _
                Alias “RtlMoveMemory” ( _
                Destination As Any, _
                Source As Any, _
                ByVal Length As Long)
Private Declare Function SQLBindCol Lib “odbc32.dll” ( _
                ByVal hstmt As Long, _
                ByVal iCol As Integer, _
                ByVal fCType As Integer, _
                ByRef rgbValue As Any, _
                ByVal cbValueMax As Long, _
                ByRef pcbValue As Long) As Integer
 
 
‘構造体(SQLDiscribeColで得た列情報と、
‘GlobalAllocによるメモリハンドルとGlobalLockによるポインタ、
‘さらに対応するADODB.Fieldオブジェクトを格納する)
Private Type ODBCField
    FieldName As String
    NameLength As Integer
    FieldType As Integer
    FieldSize As Long
    pDecimal As Integer
    pNull As Integer
    lp As Long
    hMem As Long
    ADO_Field As ADODB.Field
End Type

Public Sub Execute(Statement As String, Optional ExecuteOnly As Boolean = False)
On Error GoTo ExecuteErr

    Dim Ret As ODBCResultEnum
   
    ‘ステートメントハンドル作成
    ODBCErrMsg = “ステートメントハンドルの作成に失敗”
    If CreateHandle(SQL_HANDLE_STMT, hdbc, hstmt) SQL_SUCCESS Then GoTo ExecuteErr
   
    If ExecuteOnly = True Then
        ‘実行のみ
        Ret = SQLExecDirect(hstmt, Statement, SQL_NTS)
    Else
        ‘データを返す(レコードセットを作成する)
        Dim i As Long
        Dim O_Field() As ODBCField
        Dim pcbValue As Long
        Dim Value() As Byte
       
        Ret = SQLPrepare(hstmt, Statement, SQL_NTS)
        Ret = SQLNumResultCols(hstmt, Column)
        ‘構文エラーはここで処理する
        If (Ret = SQL_SUCCESS) + (Ret = SQL_SUCCESS_WITH_INFO) = False Then
            Dim NativeErr As Long
            Dim SQLState As String
            Dim pcbErrorMsg As Integer
           
            SQLState = String$(10, 0)
            ODBCErrMsg = String$(512, 0)
           
            SQLGetDiagRec SQL_HANDLE_STMT, hstmt, 1, SQLState, NativeErr, ODBCErrMsg, Len(ODBCErrMsg), pcbErrorMsg
            ODBCErrMsg = Left$(ODBCErrMsg, InStr(ODBCErrMsg, Chr(0)) – 1)
            GoTo ExecuteErr
        End If
        ‘取得した列数に基づき構造体配列数を確定
        ReDim O_Field(Column – 1)
        ‘スタンドアロンレコードセット
        Set RS_ODBC = New ADODB.Recordset
       
        For i = 0 To Column – 1
            With O_Field(i)
                ‘列名のバッファ
                .FieldName = String$(32, Chr(0))
                ‘列情報の取得
                SQLDescribeCol hstmt, i + 1, .FieldName, 32, .NameLength, .FieldType, .FieldSize, .pDecimal, .pNull
                .FieldName = Left$(.FieldName, InStr(.FieldName, Chr(0)) – 1)
               
                ‘列情報に基づきレコードセットにフィールド作成
                RS_ODBC.Fields.Append .FieldName, adLongVarWChar, .FieldSize
                ‘本当は対応するデータ型を設定したかったのだが…
‘                RS_ODBC.Fields.Append .FieldName, CADOType(.FieldType), .FieldSize
               
                ‘データの格納領域を指定
                .hMem = GlobalAlloc(GMEM_MOVEABLE, .FieldSize + 1)
                .lp = GlobalLock(.hMem)
                
                ‘第4引数はポインタなのでByvalを指定する。
                Ret = SQLBindCol(hstmt, i + 1, SQL_C_CHAR, ByVal .lp, .FieldSize + 1, pcbValue)
           
            End With
        Next
       
        ‘SQL文の実行、レコードセットオープン
        Ret = SQLExecute(hstmt)
        RS_ODBC.Open
       
        On Error GoTo FetchErr
       
        ‘ADODB.Fieldオブジェクトをセット(高速化を図る)
        For i = 0 To Column – 1
            Set O_Field(i).ADO_Field = RS_ODBC.Fields(O_Field(i).FieldName)
        Next
        
        ODBCErrMsg = “データの取り出しに失敗”
        Do Until Fetch(hstmt) = SQL_NO_DATA_FOUND
            ‘レコードセットにデータを追加
            RS_ODBC.AddNew
            For i = 0 To Column – 1
                With O_Field(i)
                    ‘ポインタにある列の値を取得する
                    .ADO_Field.Value = DataEject(.lp, .FieldSize + 1, .FieldType)
                End With
            Next
        Loop
    End If
   
    ‘メモリを解放する。
    For i = 0 To Column – 1
        GlobalUnlock O_Field(i).hMem
        GlobalFree O_Field(i).hMem
    Next
    Exit Sub
FetchErr:
    For i = 0 To Column – 1
        GlobalUnlock O_Field(i).hMem
        GlobalFree O_Field(i).hMem
    Next
ExecuteErr:
    Beep
    MsgBox ODBCErrMsg, vbInformation, “エラー”
End Sub
‘SQLDiscribeColで得たデータ型をADODBのデータ型に変換
Private Function CADOType(FieldType As Integer) As ADODB.DataTypeEnum
    Select Case FieldType
        Case SQL_CHAR: CADOType = adLongVarWChar
        Case SQL_INTEGER: CADOType = adInteger
        Case SQL_SMALLINT: CADOType = adSmallInt
        Case SQL_FLOAT: CADOType = adDouble
        Case SQL_REAL: CADOType = adDouble
        Case SQL_DOUBLE: CADOType = adDouble
        Case SQL_DATETIME: CADOType = adDate
        Case SQL_VARCHAR: CADOType = adLongVarWChar
        Case SQL_VARCHARMAX: CADOType = adLongVarWChar
        Case SQL_TIMESTAMP: CADOType = adDBTimeStamp
        Case SQL_VERBINARY: CADOType = adLongVarBinary
        Case SQL_BIGINT: CADOType = adBigInt
        Case SQL_TINYINT: CADOType = adTinyInt
        Case SQL_BIT: CADOType = adBoolean
        Case SQL_NCHAR: CADOType = adLongVarWChar
        Case SQL_NVARCHAR: CADOType = adLongVarWChar
        Case SQL_NVARCHARMAX: CADOType = adLongVarWChar
        Case SQL_GUID: CADOType = adGUID
        Case SQL_VARIANT: CADOType = adVariant
        Case SQL_MONEY: CADOType = adCurrency
    End Select
End Function
Public Property Get Recordset() As ADODB.Recordset
    Set Recordset = RS_ODBC
End Property
‘ODBCAPIの返り値は直接条件分岐に使うとおかしな値が返る場合があるので
‘Functionをかませる。
Private Function Fetch(hstmt As Long) As Integer
    Fetch = SQLFetch(hstmt)
End Function
‘ポインタから値を取得し、データ型に応じて値を変換する(CopyMemory使用)
Private Function DataEject(lp As Long, Length As Long, FieldType As Integer) As Variant
    Dim Temp() As Byte
    ReDim Temp(Length)
    CopyMemory Temp(0), ByVal lp, Length
    DataEject = StrConv(Temp, vbUnicode)
    DataEject = Left$(DataEject, InStr(DataEject, Chr(0)) – 1)
   
    Select Case FieldType
        Case SQL_CHAR, SQL_VARCHAR, SQL_VARCHARMAX, SQL_NCHAR, SQL_NVARCHAR, SQL_NVARCHARMAX, SQL_VARIANT
        Case SQL_INTEGER, SQL_SMALLINT, SQL_BIGINT, SQL_TINYINT
            DataEject = CLng(DataEject)
        Case SQL_FLOAT, SQL_REAL, SQL_MONEY
            DataEject = CCur(DataEject)
        Case SQL_DOUBLE
            DataEject = CDbl(DataEject)
        Case SQL_DATETIME
            DataEject = CDate(Left$(DataEject, 19))
        Case SQL_TIMESTAMP
        Case SQL_VERBINARY
        Case SQL_BIT
            DataEject = CBool(DataEject)
        Case SQL_GUID
            DataEject = “{” & DataEject & “}”
    End Select
End Function
‘種類別に各ハンドルを作成する
Private Function CreateHandle(HandleType As HandleTypeEnum, InputHandle As Long, OutputHandle As Long) As ODBCResultEnum
    Select Case HandleType
        Case SQL_HANDLE_ENV
            CreateHandle = SQLAllocEnv(OutputHandle)
        Case SQL_HANDLE_DBC, SQL_HANDLE_STMT, SQL_HANDLE_DESC
            CreateHandle = SQLAllocHandle(HandleType, InputHandle, OutputHandle)
    End Select
End Function

ADOのRecordsetをフォームに利用 番外編

今回は「自作した」レコードセットにデータを追加し、それをフォームに表示させる場合のメモ。
「自作した」レコードセットとはSQL文に依らないレコードセットのことで、
SQL文に依らないのでフィールドの数、型宣言、データの追加等をすべて自分で行う必要があります。
作業用のテーブルがかなり近い感覚。
今後この「自作した」レコードセットを「スタンドアロンレコードセット」と呼ぶことにします。

スタンドアロンレコードセットの作り方
1. ADODB.Recordsetを作成する

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

2. フィールド(列)を作成する

rs.Fields.Append , , , ,

あとは普通のレコードセットと同じでRecordsetを開き、Addnewメソッドでデータを追加して完成です。

rs.Open
rs.AddNew Array(“TESTID”, “TEST”), Array(1, “test”)

出来たレコードセットをフォームのレコードセットに代入すればいいのですが

Set Me.サブフォーム1.Form.Recordset = rs

おそらくテキストボックスに「#エラー」がでます。
自分もよくわかりませんが、フィールドのデータ型が
adLongVarWChar以外でこうなるようです。

もしかしたらAppendの第四引数が関係しているかもしれませんがよくわかりません。

Sumの途中経過を表示する

棚卸数 50

日付     移動数  在庫数
10/01     100        150
10/13     80          230
10/25     -130       100
11/06     40          140
11/10     -50         90
11/13     -60         30

在庫数 30

在庫関係の帳票を作る場合このようなデータを見せる場合がある。
このように上から順に足した結果を表示するのは非常に面倒。

SQLServerだけでやろうとした場合、カーソルや作業用の一時テーブルを使うことになると思うが
なんとかできないものかと考えた。
(自分には他の方法は思いつかないだけなので方法を知っている方がいましたらぜひ教えてください。)
そのうち「完全に」出来るようになると思うのでメモ。

参考URL:CLR ユーザー定義集計関数の呼び出し
上記にあるようなユーザー定義集計で文字列を結合する。
Over句が使用可能なはずなので行数を維持しつつ文字列集計する。
更にRow_Number関数で行番号を振る。

日付    移動数 在庫数    CLR集計                           行番号
10/01     100      150        100,80,-130,40,-50,-60       1
10/13     80        230        100,80,-130,40,-50,-60       2
10/25     -130     100        100,80,-130,40,-50,-60       3
11/06     40        140        100,80,-130,40,-50,-60       4
11/10     -50       90          100,80,-130,40,-50,-60       5
11/13     -60       30          100,80,-130,40,-50,-60       6

すると上記のようなデータになる。

ALTER FUNCTION [dbo].[CommaSum]
(
 @String nvarchar(max),
 @CalcCount int
)
RETURNS nvarchar(max)
AS
BEGIN
 declare @instr1 int set @instr1=-1
 declare @instr2 int set @instr1=-1
 declare @Calc nvarchar(50) set @Calc=0
 declare @i int set @i=0
 while @i<@CalcCount begin
  set @instr2=charindex(‘,’,@String,@instr1+1)
  set @Calc=@Calc+cast(SUBSTRING(@String,@instr1+1,(case when @instr2=0 then LEN(@String)+1 else @instr2-1 end)-@instr1) as money)
  –set @Calc=SUBSTRING(@String,@instr1+1,(case when @instr2=0 then LEN(@String)+1 else @instr2-1 end)-@instr1)
  set @instr1=@instr2
  set @i=@i+1
 end
 return @Calc
END

あとは上記のようなSplitのような感じでコンマを区切り、
各要素を足していくユーザー定義関数を作成する。
この時足し算を行う回数を任意に指定出来るようにしておけばRow_Numberを引数にあてて

「100,80,-130,40,-50,-60」に対して

1行目はコンマ1つ目まで足す  →100
2行目はコンマ2つ目まで足す  →100+80
3行目はコンマ3つ目まで足す  →100+80+(-130)
4行目はコンマ4つ目まで足す  →100+80+(-130)+40

となり任意の結果が得られる。

しかしユーザー定義集計のSqlUserDefinedAggregateAttribute クラスでは
重要な「IsInvariantToOrder」プロパティが未実装であり、
これに依るものかなぜかOver句でorder byを指定できずでエラーになるため
ユーザー定義集計時の並び順がさっぱりわからない上に変わらない。(partition byは可能)

もう少し待たないとこの方法は使えない。そもそもパフォーマンスがいいのかも不明。
一時テーブルにインサート&カーソルよりは早いことを期待したい。

VBAからODBC APIを使う 実行編

前の記事:VBAからODBC APIを使う 接続編

データのアクセス部分に入ります。
データを返さないSQL文はSQLExecDirectで実行し、
それ以外はSQLExecuteで実行するといいと思います。

‘ODBC API
Private Declare Function SQLExecDirect Lib “odbc32.dll” ( _
                ByVal hstmt As Long, _
                ByVal szSqlStr As String, _
                ByVal cbSqlStr As Long) As Integer

Private Declare Function SQLPrepare Lib “odbc32.dll” ( _
                ByVal hstmt As Long, _
                ByVal szSqlStr As String, _
                ByVal cbSqlStr As Long) As Integer

Private Declare Function SQLNumResultCols Lib “odbc32.dll” ( _
                ByVal hstmt As Long, _
                ByRef pcCol As Integer) As Integer

Private Declare Function SQLExecute Lib “odbc32.dll” ( _
                ByVal hstmt As Long) As Integer

Private Declare Function SQLDescribeCol Lib “odbc32.dll” ( _
                ByVal hstmt As Long, _
                ByVal iCol As Integer, _
                ByVal ColName As String, _
                ByVal NameLen As Integer, _
                ByRef pNameLen As Integer, _
                ByRef DataType As Integer, _
                ByRef ColSize As Long, _
                ByRef pDecimal As Integer, _
                ByRef pNull As Integer) As Integer

Private Declare Function SQLFetch Lib “odbc32.dll” ( _
                ByVal hstmt As Long) As Integer

Private Declare Function SQLGetData Lib “odbc32.dll” ( _
                ByVal hstmt As Long, _
                ByVal iCol As Integer, _
                ByVal fCType As Integer, _
                ByVal pValue As Any, _
                ByVal BufLen As Long, _
                ByRef pcbValue As Long) As Integer

Private Const SQL_NTS = -3
Private Const SQL_NO_DATA_FOUND = 100

‘データ型(SQLServerのデータ型を試してみた)返り値
Private Const SQL_CHAR = 1
Private Const SQL_NUMERIC = 2
Private Const SQL_DECIMAL = 3
Private Const SQL_INTEGER = 4
Private Const SQL_SMALLINT = 5
Private Const SQL_FLOAT = 6
Private Const SQL_REAL = 7
Private Const SQL_DOUBLE = 8
Private Const SQL_DATETIME = 11
Private Const SQL_VARCHAR = 12
Private Const SQL_VARCHARMAX = -1
Private Const SQL_TIMESTAMP = -2
Private Const SQL_VERBINARY = -4
Private Const SQL_BIGINT = -5
Private Const SQL_TINYINT = -6
Private Const SQL_BIT = -7
Private Const SQL_NCHAR = -8
Private Const SQL_NVARCHAR = -9
Private Const SQL_NVARCHARMAX = -10
Private Const SQL_GUID = -11
Private Const SQL_VARIANT = -150
Private Const SQL_MONEY = SQL_DECIMAL Or SQL_NUMERIC

‘ODBC データ型(何があるのかよくわからない)
Private Const SQL_C_CHAR = SQL_CHAR
Private Const SQL_C_LONG = SQL_INTEGER
Private Const SQL_C_SHORT = SQL_SMALLINT
Private Const SQL_C_FLOAT = SQL_REAL
Private Const SQL_C_DOUBLE = SQL_DOUBLE

Public Sub ExecuteODBC1()
     Const stmt = “insert into table1 values (1,’a’)”
     ‘ステートメントハンドル作成
     Ret = SQLAllocHandle(SQL_HANDLE_STMT, hdbc, hstmt)

     ‘SQL文を実行する
     Ret = SQLExecDirect(hstmt, stmt, SQL_NTS)
End Sub

Public Sub ExecuteODBC2()
    Dim ColDataType As New Collection
    Dim Column As Long
    Dim i As Long
    Dim ColName As String
    Dim NameLen As Integer
    Dim DataType As Integer
    Dim ColSize As Long
    Dim pDecimal As Integer
    Dim pNull As Integer
    Dim pcbValue As Long
    Const stmt = “select * from table1”
    ‘ステートメントハンドル作成
    Ret = SQLAllocHandle(SQL_HANDLE_STMT, hdbc, hstmt)
   
    Ret = SQLPrepare(hstmt, stmt, SQL_NTS)
    Ret = SQLNumResultCols(hstmt, Column)
   
    ‘列の解析
    For i = 0 To Column – 1
        ColName = String$(32, Chr(0))
        SQLDescribeCol hstmt, i + 1, ColName, 32, NameLen, DataType, ColSize, pDecimal, pNull
        ‘ColName  列名 Left$(ColName,Instr(ColName, Chr(0)))
        ‘NameLen 列名の長さ
        ‘DataType データ型
        ‘ColSize    データ長
        ‘あと2つはまだわかりませんm(__)m
        ColDataType.Add DataType, Left$(ColName, InStr(ColName, Chr(0)) – 1)
    Next
   
    ‘SQLの発行
    Ret = SQLExecute(hstmt)
   
    Do Until Fetch(hstmt) = SQL_NO_DATA_FOUND
            For i = 0 To Column – 1
                Select Case ColumnType(i + 1)
                    Case SQL_INTEGER
                        Ret = SQLGetData(hstmt, i + 1, SQL_C_LONG, VarPtr(ValueInt), 4, pcbValue)
                        Debug.Print ValueInt
                    Case SQL_NVARCHAR
                        ValueStr = String$(500, Chr(0))
                        Ret = SQLGetData(hstmt, i + 1, SQL_C_CHAR, ValueStr, 500, pcbValue)
                        Debug.Print ValueStr
                End Select
            Next
    Loop
End Sub

Private Function Fetch(hstmt As Long) As Integer
    Fetch = SQLFetch(hstmt)
End Function

ただしこのやり方は行数×列数の数だけSQLGetDataを呼び出す必要がありますので遅いらしいです。
SQLBindColを使うといいらしいのですが…
追記:SQLBindColを使った方法はこちら

VBAからODBC APIを使う 接続編

前の記事:VBAからODBC APIを使う 準備編

ハンドルの割り当てが完了したらデータベースへの接続を行います。

接続に使う関数は2種類ほど見つかりました。
・SQLConnect
・SQLDriverConnect
SQLConnect関数はDSNとユーザー、パスワードを指定し接続します。
SQLDriverConnect関数は接続文字列を指定し接続します。
DSNの作成がめんどくさいのでDSN-Lessの後者を利用します。
それにしても定数の値探すの大変orz

 
‘ SQLDriverConnect用オプション
Private Const SQL_DRIVER_NOPROMPT As Integer = 0
Private Const SQL_DRIVER_COMPLETE As Integer = 1
Private Const SQL_DRIVER_PROMPT As Integer = 2
Private Const SQL_DRIVER_COMPLETE_REQUIRED As Integer = 3
‘接続関数
Private Declare Function SQLDriverConnect Lib “odbc32.dll” ( _
                        ByVal hdbc As Long, _
                        ByVal hWindow As Long, _
                        ByVal szConnStr As String, _
                        ByVal cbConnnStr As Integer, _
                        ByVal szConnOut As String, _
                        ByVal cbConnOutMax As Integer, _
                        ByRef pcbConnOut As Integer, _
                        ByVal fDriverConpletion As Integer) As Integer
‘切断関数
Private Declare Function SQLDisconnect Lib “odbc32.dll” ( _
                ByVal hdbc As Long) As Integer
‘接続関数
Public Function ConnectODBC() As Boolean
    Dim OutConnStr As String
    Dim pcbConnOut As Integer
   
    OutConnStr = String$(512, 0)
   
    ‘SQLServerの場合
    InConnStr = “Driver={SQL Server};Server=????;Database=????”
   
    Ret = SQLDriverConnect(hdbc, hWndAccessApp, _
                            InConnStr, Len(InConnStr), _
                            OutConnStr, Len(OutConnStr), _
                            pcbConnOut, SQL_DRIVER_COMPLETE_REQUIRED)
    If Ret = SQL_SUCCESS Or Ret = SQL_SUCCESS_WITH_INFO Then
        ConnectODBC = True
        SQLDisconnect hdbc
    Else
        ConnectODBC = False
    End If
End Function
 

VBAからODBC APIを使う 準備編

VBAからodbc32.dllの関数を直接呼び出し、最終的にはデータを取得してみます。
RDOやDAO等のミドルウェアを挟まないので処理が早くなることを期待します(かなり怪しいです)。

参考URL:http://www.amy.hi-ho.ne.jp/jbaba/vbapi2.htm
                :http://support.microsoft.com/kb/110470/ja
                :http://itref.fc2web.com/database/odbc.html#sqlexecdirect
                :http://www.activevb.de/rubriken/apikatalog/deklarationen/sqldriverconnect.html
最後のURLはAPIを調べるために使います。
では早速。まずハンドル(long型)の割り当てが必要です。それぞれ
・環境ハンドル                   (変数 henv)
・データベース接続ハンドル(変数 hdbc)
・ステートメントハンドル      (変数 hstmt)
を割り当てます。
次に必要な関数を定義します。
旧バージョンではSQLAllocEnv(環境ハンドル用)、SQLAllocConnect(データベース接続ハンドル用)、SQLAllocStmt(ステートメントハンドル用)の3種類
新バージョンではSQLAllocHandleで統一されている…とのことですがなぜかhdbcが割り当てできないので
環境ハンドルはSQLAllocEnvで、それ以外はSQLAllocHandleで用意します。

‘ODBC APIの返り値定数
Private Const SQL_ERROR             As Long = -1
Private Const SQL_INVALID_HANDLE    As Long = -2
Private Const SQL_NO_DATA_FOUND     As Long = 100
Private Const SQL_SUCCESS           As Long = 0
Private Const SQL_SUCCESS_WITH_INFO As Long = 1

‘SQLAllocHandle用定数
Private Const SQL_NULL_HANDLE       As Long = 0
Private Const SQL_HANDLE_ENV        As Long = 1
Private Const SQL_HANDLE_DBC        As Long = 2
Private Const SQL_HANDLE_STMT       As Long = 3

‘ハンドル割当関数
Private Declare Function SQLAllocHandle Lib “odbc32.dll” ( _
                        ByVal HandleType As Integer, _
                        ByRef InputHandle As Long, _
                        ByRef OutputHandle As Long) As Integer

Private Declare Function SQLAllocEnv Lib “odbc32.dll” ( _
                        ByRef phenv As Long) As Integer

‘ハンドル解放関数
Private Declare Function SQLFreeHandle Lib “odbc32.dll” ( _
                        ByVal HandleType As Integer, _
                        ByRef handle As Long) As Integer

Public Sub BeginODBC()
On Error GoTo HandleErr
    Dim Msg As String
    Dim Ret As Integer
   
    ‘環境ハンドル取得
    ‘If SQLAllocEnv(henv) SQL_SUCCESS Then ‘変数で受けないと結果がおかしいのでだめ
    Ret = SQLAllocEnv(henv)
    If Ret SQL_SUCCESS Then
        Msg = “環境ハンドル取得失敗”
        GoTo HandleErr
    End If
   
    ‘データベース接続ハンドル取得
    ‘SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, henv)で取得しているとエラー
    ‘If SQLAllocHandle(SQL_HANDLE_DBC, henv, hdbc) SQL_SUCCESS Then
    Ret = SQLAllocHandle(SQL_HANDLE_DBC, henv, hdbc)
    If Ret SQL_SUCCESS Then
        Msg = “データベース接続ハンドル取得失敗”
        GoTo HandleErr
    End If
   
HandleErr:
    If Len(Msg) > 0 Then MsgBox Msg
   
    ‘ハンドル解放
    EndODBC
End Sub

Public Sub EndODBC()
    If hdbc > 0 Then SQLFreeHandle SQL_HANDLE_DBC, hdbc
    If henv > 0 Then SQLFreeHandle SQL_HANDLE_ENV, henv
End Sub

ハンドルの割り当てが成功すれば次は接続を行ないます。

切断したレコードセットとバッチ更新モード

参考URL:http://blogs.msdn.com/b/nakama/archive/2008/10/16/ado.aspx

ADOのRecordsetをフォームに利用1で少しこの件について書いたが自分には重要なのでメモ。

切断型のレコードセットの作り方
1. RecordsetのOpen前に「CursorLocation」にadUseClient(=3)を設定する

 
rs.CursorLovation = adUseClient
 

2. RecordsetのOpen後に「ActiveConnection」をNothingする

set rs.CursorLovation = Nothing
 

結構簡単ですがこれでデータソースから切り離されたRecordsetの完成です。

次にバッチ更新についてですがこれは「バッチ更新モード」というもので
基本Recordsetは「即時更新モード」で動きUpdateメソッド等でデータベースが「即」更新されます。
(ウチの会社ではこれしか使ってなかった)

これに対し「バッチ更新モード」は変更を溜めてUpdateBatchメソッドで一気にデータベースを更新します。
切断型のレコードセットを使うのに1行更新するごとにデータベースに繋ぐのでは
あまり意味が無いので大雑把かもしれませんが私は

・接続型レコードセットは「即時更新モード」
・切断型レコードセットは「バッチ更新モード」

更新が必要な場合はこのように動かすといいと思っています。

「バッチ更新モード」にするにはRecordsetの「RockType」をadLockBatchOptimistic(=4)に設定する
Open前に設定する場合

 
rs.LockType = adLockBatchOptimistic
 

Open時に設定する場合(第4引数にLockTypeオプションがある)

 
rs.Open , Conn, adOpenStatic, adLockBatchOptimistic

切断したレコードセットの変更をデータソースに書きこむには
1. Recordsetの「ActiveConnection」にアクティブなConnectionを設定する

Conn.Open
rs.ActiveConnection = Conn

2. UpdateBatchメソッドを実行する

rs.UpdateBatch
 

これらの基本操作をしっかり覚えておく。

サブフォームが影響されるメインフォームのプロパティ

ズバリ一番困るのは「更新の許可」プロパティです。
ほか前の記事でも取り上げた「ショートカットメニュー」や「フィルターの使用」等の
プロパティはサブフォームとメインフォームで設定が違った場合、
メインフォームの設定になります。

「更新の許可」は入力すらできませんので気づくかもしれませんが
その他はわかりにくく、結構ハマリます。