Attribute VB_Name = "ador2"
'___________________________________________________________
'sample-vbaxlado2-1 version 1.1, Copyright (C) 2001 Tomizono <tomizono@yahoo.com>
'sample-vbaxlado2-1 comes with ABSOLUTELY NO WARRANTY. This is free software,
'and you are welcome to redistribute it under certain conditions.
'See http://www.gnu.org/copyleft/gpl.html#SEC3 for details.
'___________________________________________________________
'discribes howto treat ADO Connection objects.
'this is a VBA module source for MS Excel.
'this version: http://www.geocities.com/tomizono/gpl/2001/sample-vbaxlado2-1.1.1.bas
'lattest: http://www.geocities.com/tomizono/gpl/sample-vbaxlado2-1.bas
'
'Further information is available at:
'http://www.geocities.com/tomizono/vba/db.ado2.html
'___________________________________________________________
'sample-vbaxlado2-1: discribes howto treat ADO Connection objects.
'Copyright (C) 2001 Tomizono <tomizono@yahoo.com>
'
'This program is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation; either version 2 of the License, or
'(at your option) any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'GNU General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'___________________________________________________________

Option Explicit

'---- ExecuteOptionEnum Values ----
Const adExecuteNoRecords = &H80

Sub ado12()
' ADO のバージョン。
    Dim Con1 As Object
    Set Con1 = CreateObject("ADODB.Connection")
    MsgBox Con1.Version
    Set Con1 = Nothing
End Sub

Sub ado13()
' ADO Connection で Recordset を返す。
    Dim Source As String, Con As String
    Dim Con1 As Object, Rs1 As Object
    Dim FieA As Object, a As String
    a = ""
    Source = "select * from Table1"
    Con = "DSN=db1;"
    Set Con1 = CreateObject("ADODB.Connection")
    Con1.ConnectionString = Con
    Con1.Open
    Set Rs1 = Con1.Execute(Source)
    If Not Rs1.EOF Then
        For Each FieA In Rs1.Fields
            a = a & "<" & FieA.Name & ">" & FieA.Value
        Next FieA
    End If
    Rs1.Close
    Set Rs1 = Nothing
    Con1.Close
    Set Con1 = Nothing
    MsgBox a
End Sub

Sub ado14()
' ADO Connection で データを更新する。
    Dim Source As String, Con As String
    Dim Con1 As Object
    Dim FieA As Object
    Source = "Insert Into Table1(Namae) Select '五右衛門'"
    Con = "DSN=db1;"
    Set Con1 = CreateObject("ADODB.Connection")
    Con1.ConnectionString = Con
    Con1.Open
    Con1.Execute Source
    Con1.Close
    Set Con1 = Nothing
End Sub

Sub ado14b()
' ADO Connection で データを更新する。
    Dim Source As String, Con As String
    Dim Con1 As Object
    Dim FieA As Object, i  As Long
    Source = "Delete From Table1 Where Namae = '五右衛門'"
    Con = "DSN=db1;"
    Set Con1 = CreateObject("ADODB.Connection")
    Con1.ConnectionString = Con
    Con1.Open
    Con1.Execute Source, i, adExecuteNoRecords
    Con1.Close
    Set Con1 = Nothing
    MsgBox i
End Sub

Sub ado14c()
' ADO Connection で データを更新する。
    Dim Source As String, Con As String
    Dim Con1 As Object
    Dim FieA As Object, i  As Long
    Source = "Update Table1 Set Namae = '五右衛門' Where ID = 5"
    Con = "DSN=db1;"
    Set Con1 = CreateObject("ADODB.Connection")
    Con1.ConnectionString = Con
    Con1.Open
    Con1.Execute Source, i, adExecuteNoRecords
    Con1.Close
    Set Con1 = Nothing
    MsgBox i
End Sub

Sub ado15(Source As String)
' ADO Connection で SQL による読み書きを実行する。
    Dim Con As String
    Dim Con1 As Object, Rs1 As Object
    Dim FieA As Object, a As String, i As Long
    a = ""
    Con = "DSN=db1;"
    Set Con1 = CreateObject("ADODB.Connection")
    Con1.ConnectionString = Con
    Con1.Open
    Set Rs1 = Con1.Execute(Source, i)
    If i > 0 Then
        a = i & " 件のレコードが更新されました。"
    ElseIf Rs1.EOF Then
        a = "該当するデータはありません。"
        Rs1.Close
    Else
        For Each FieA In Rs1.Fields
            a = a & "<" & FieA.Name & ">" & FieA.Value
        Next FieA
        Rs1.Close
    End If
    Set Rs1 = Nothing
    Con1.Close
    Set Con1 = Nothing
    MsgBox a
End Sub

Sub ado16()
' ADO Connection で SQL による読み書きを実行する。
    ado15 "select * from Table1 where id=1"
    ado15 "select * from Table1 where id=0"
    ado15 "Insert Into Table1(Namae) Select 'ぱふ'"
End Sub