バージョンアップされた
oo4o

Const mcOLE = "OracleInProcServer.XOraSession"

Private Sub cmdOK_Click()
  Dim strConnect      As String
  Dim strHost         As String

  strConnect = Trim$(txtUser.Text)
  If Len(Trim$(txtPass.Text)) > 0 Then
    strConnect = strConnect & "/" & Trim$(txtPass.Text)
  End If
  strHost = Trim$(txtHost.Text)

  Set pobjSess = CreateObject(mcOLE)
  Set pobjDb = _
   pobjSess.DbCreateDatabase(strHost, strConnect, 3&)
End Sub

Private Sub cmdSearch_Click()
  Dim strSQL        As String
  Dim objDs         As Object
  Dim strErrText    As String

  On Error GoTo errClick:

  strSQL = "SELECT * FROM emp"
  Set objDs = pobjDb.DbCreateDynaset(strSQL, 8&)	…(1)
  lstResult.Clear
  Do While Not objDs.EOF				…(2)
    lstResult.AddItem objDs("empno").Value		…(3)
    objDs.DbMoveNext					…(4)
  Loop

exitClick:
  On Error Resume Next
  Set objDs = Nothing					…(5)
  Exit Sub

errClick:
  If pobjSess.LastServerErr = 0 Then
    If pobjDb.LastServerErr = 0 Then
      strErrText = Error$
    Else
      strErrText = pobjDb.LastServerErrText
      pobjDb.LastServerErrReset
    End If
  Else
    strErrText = pobjSess.LastServerErrText
    pobjSess.LastServerErrReset
  End If
  MsgBox strErrText, vbOKOnly + vbExclamation, App.Title
  Resume exitClick:
End Sub

Private Sub cmdUpdate_Click:

  On Error Goto errClick:

  strSQL = "SELECT * FROM emp"
  Set objDs = pobjDb.DbCreateDynaset(strSQL, 0&)
  If objDs.Eof Then
     objDs.DbAddNew							…(1)
  Else
      objDs.DbEdit							…(2)
  End If
  objDs("ename").Value = "TestUsers" & objDs("ename").Value		…(3)
  objDs.Update								…(4)

exitClick:
  On Error Resume Next
  Exit Sub

errClick:
  If pobjSess.LastServerErr = 0 Then
    If pobjDb.LastServerErr = 0 Then
      strErrText = Error$
    Else
      strErrText = pobjDb.LastServerErrText
      pobjDb.LastServerErrReset
    End If
  Else
    strErrText = pobjSess.LastServerErrText
    pobjSess.LastServerErrReset
  End If
  MsgBox strErrText, vbOKOnly + vbExclamation, App.Title
  Resume exitClick:
End Sub

  pobjDb.Parameters.Add "strEname", "0", 1		…(1)
  strSQL = "UPDATE emp SET ename = ename || strEname"
  For iintLoop = 1 To 1000
    pobjDb.Parameters("intID") = iintLoop
    lngRet = pobjDb.DbExecuteSQl(strSQL)
  Next

exitClick:
  On Error Resume Next
  pobjDb.Parameters.Remove "strEname"			…(2)
  Exit Sub

errClick:
  <エラー処理>
  Resume exitClick:

  poraDb.Parameters.Add "intCnt", 0, 2
  poraDb.Parameters.AddTable "astrItem", 2, 1, 1000, 20			…(1)
  Set objSpread = poraDb.Parameters("astrItem")				…(2)
  strSQL = "BEGIN pkgTEST.subTEST1(:astrItem,:intCnt); END;"		…(3)
  poraDb.DbExecuteSQL (strSQL)						…(4)

  grdResult.Rows = poraDb.Parameters("intCnt").Value \ 8		…(5)
  grdResult.Row = 0
  For ilngRow = 1 To grdResult.Rows - 1
    grdResult.Row = grdResult.Row + 1
    For ilngCol = 0 To grdResult.Cols - 1
      grdResult.Col = ilngCol
      lngPos = ilngCol + (ilngRow - 1) * 8 + 1				…(6)
      grdResult.Text = poraDb.Parameters("astrItem").get_Value(lngPos)	…(7)
    Next
  Next

exitClick:
  On Error Resume Next
  poraDb.Parameters.Remove "intCnt"
  poraDb.Parameters.Remove "astrItem"					…(8)
  Set objSpread = Nothing						…(9)
  Exit Sub