ＡＤＯについて (ID:87546)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

たくみです。
返事が遅くなってすみません。もう見てませんかねえ？

とりあえずテストコードを書いて試してみました。
イメージはこんな感じです。
あくまでもイメージなんでいろいろとはしょって書いてます。

本来はByRefはあまり使いたくないのですが
仕様が仕様だけにとりあえずByRefで引数としてコネクションを
引き渡しています。
ちなみにこのコードで（コネクション文字列を適切に与えたら）
ちゃんとノーエラーで動作してますよ。

※親アプリ側のイメージ
Private Sub Command1_Click()
    Dim CnTmp As ADODB.Connection
    Dim RsTmp As ADODB.Recordset
    Dim sFlg As String
    Dim SQL As String
    Dim bRet As Boolean

On Error GoTo ErrLab
    
    Set CnTmp = New ADODB.Connection
    
    With CnTmp
        .Errors.Clear
        .Mode = adModeReadWrite     'これ結構ポイント
        .ConnectionString = "どうのこうの"  'あくまでイメージ

'ADOコネクションのオープン
        If .State = adStateClosed Then
            .Open
        End If
    
        'オープンできたかのチェック
        If .State <> adStateOpen Then
            MsgBox "コネクションが確立できません", vbExclamation + vbOKOnly
            Exit Sub
        End If
    End With

SQL = "SELECT * FROM MyTable"  'あくまでイメージ

Set RsTmp = New ADODB.Recordset

With RsTmp

'Rs作成
        RsTmp.Open SQL, CnTmp, _
	  adOpenDynamic, adLockOptimistic, adCmdText
    
        If .EOF Then
	    'エラーエコーをここに書く
            Exit Sub
        End If

End With
    
    'ここに受注データ作成処理を書く
    '・
    '・

'ここが在庫引当処理のつもり
    bRet = PutCn(CnTmp, sFlg, RsTmp)

'ここに出荷データ作成処理を書く
    '・
    '・

RsTmp.Close
    Set RsTmp = Nothing
    CnTmp.Close
    Set CnTmp = Nothing

Exit Sub

ErrLab:

End Sub

'※ここがActiveDLL側に置く処理イメージです
Public Function PutCn(ByRef Cn As ADODB.Connection, _
                     ByRef CnTranStat As String, _
                     ByRef Rs As ADODB.Recordset _
                     ) As Boolean
    On Error GoTo ErrLab

PutCn = False

'あまり意味ないけどとりあえず現在のCnの状態をフラグに書いておく
    CnTranStat = "Before_BeginTrans"
    
    Cn.BeginTrans

CnTranStat = "After_BeginTrans"
    
    Rs.Fields(0).Value = "ABC"  'とりあえず最初の文字項目にABCと書いてみる
    Rs.Update                   '本当はここにメインの在庫引当て処理を書く

CnTranStat = "Before_CommitTrans"
    
    Cn.CommitTrans

CnTranStat = "After_CommitTrans"
        
    MsgBox CnTranStat

PutCn = True

Exit Function
    
ErrLab:
    MsgBox CnTranStat, vbCritical + vbSystemModal

End Function

←解決時は質問者本人がここをチェックしてください。

戻る