ADO Database Connection

From Training Material
Jump to navigation Jump to search


Zanim zaczniesz, pamiętaj aby dodać referencje do Microsoft ActiveX Data Objects xx Library

Add ADO Library.JPG


http://www.connectionstrings.com/ tu znajdziesz gotowe wzory connection string dla dowolnej bazy danych.

UDL files

Example1

Option Explicit
Const cs As String = "Provider=OraOLEDB.Oracle.1;Password=asdf;Persist Security Info=False;User ID=SYSTEM;Data 
 --------------------------------------------------------------------------------------------------------------------
Sub ConnectTODataBase()
Dim c As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim f As ADODB.Field
Dim w, k
 
    c.ConnectionString = cs
    c.Open
    Call rs.Open("select * from HELP", c)
    Cells.Clear
    
    For Each f In rs.Fields
        k = k + 1
        Cells(1, k).Font.Bold = True
        Cells(1, k) = f.Name
    Next
    k = 0
    w = 1
        Do Until rs.EOF
            w = w + 1
                For Each f In rs.Fields
                    k = k + 1
                    Cells(w, k) = f.Value
                Next f
                k = 0
            rs.MoveNext
        Loop
    c.Close
Columns.AutoFit
End Sub

Example2

Sub polaczenieZBazaDanych1()
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
    MsgBox "Połączenie utworzone"
    conn.Close
    Set conn = Nothing
    MsgBox "Połączenie utracone"
End Sub
Sub polaczenieZBazaDanych2()
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source = C:\Northwind.mdb"
        .Open
    End With
    MsgBox "Połączenie utworzone"
    conn.Close
    Set conn = Nothing
    MsgBox "Połączenie utracone"
End Sub

Example3

Sub polaczenieZBazaDanych3()
'obsluga bledow
On Error GoTo blad
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
    MsgBox "Połączenie utworzone"
    conn.Close
    Set conn = Nothing
    MsgBox "Połączenie utracone"
    Exit Sub
blad:
    MsgBox Err.Number & ": " & Err.Description
End Sub
Sub polaczenieZBazaDanych4()
'obsluga recordset
On Error GoTo blad
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    Dim rs As New ADODB.Recordset
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
        MsgBox "Połączenie utworzone"
        rs.Source = "SELECT * FROM Klienci"
        rs.Open , conn
            Debug.Print rs.Fields.Count
            Debug.Print rs("NazwaFirmy"), rs("Miasto")
        rs.Close
        Set rs = Nothing
    conn.Close
    Set conn = Nothing
    MsgBox "Połączenie utracone"
    Exit Sub
blad:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Example4

Sub polaczenieZBazaDanych5()
'obsluga recordset c.d.
On Error GoTo blad
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    Dim rs As New ADODB.Recordset
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
        MsgBox "Połączenie utworzone"
        rs.Source = "SELECT * FROM Klienci"
        rs.Open , conn
            Debug.Print rs.Fields.Count
            Do While Not rs.EOF
                Debug.Print rs.Fields(1).Value, rs.Fields(5).Value
                'Debug.Print rs("NazwaFirmy"), rs("Miasto")
            rs.MoveNext
            Loop
        rs.Close
        Set rs = Nothing
    conn.Close
    Set conn = Nothing
    MsgBox "Połączenie utracone"
    Exit Sub
blad:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Example5

Sub polaczenieZBazaDanych6()
'zapisywanie recordsetu do pliku
On Error GoTo blad
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    Dim rs As New ADODB.Recordset
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
        MsgBox "Połączenie utworzone"
        rs.Source = "SELECT * FROM Klienci"
        rs.Open , conn
        '------ zapis do pliku XML
        rs.Save "c:\kurs\klienci.xml", adPersistXML
        '---------------------------
        rs.Close
        Set rs = Nothing
    conn.Close
    Set conn = Nothing
    MsgBox "Połączenie utracone"
    Exit Sub
blad:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Example6

'--------- do cwiczenia: tworzenie formularza, ktorego pole kombi pobiera dane z rekordsetu
'--------- formularz frmRecordSet

' --------------------wywołanie kwerendy
Sub Execute_Query()
    Dim rek As Integer
    Dim rs As New ADODB.Recordset
On Error GoTo ErrorHandler

    rs.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
    rs.Source = "Faktury"
    rs.Open
        Worksheets("Arkusz2").Range("a1").CopyFromRecordset rs
    rs.Close
    
Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
End Sub
Sub ExecuteParamQuery1()
'wywolanie kwerendy parametrycznej - sposob pierwszy
On Error GoTo ErrorHandler
    Dim cmd1 As ADODB.Command
    Set cmd1 = New ADODB.Command
    Dim rs1 As ADODB.Recordset
    cmd1.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
    cmd1.CommandText = "[Filtr Faktur]"
    cmd1.CommandType = adCmdStoredProc
    cmd1.Parameters.Refresh
    
    Set rs1 = cmd1.Execute(Parameters:=Array(10248))
    
    Arkusz4.Range("a10").CopyFromRecordset rs1
    
    rs1.Close
    Set rs1 = Nothing
Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Example7

'------------------------------ ADOX
'przyklad wykorzystania biblioteki ADOX
Sub Create_Table()
    Dim cat As ADOX.Catalog
    Dim myTbl As ADOX.Table
On Error GoTo ErrorHandler

    Set cat = New Catalog
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Northwind.mdb"
    Set myTbl = New Table
    With myTbl
        .Name = "tblFiltr"
            With .Columns
                .Append "Id", adVarWChar, 10
                .Append "Opis", adVarWChar, 255
                .Append "Typ", adInteger
            End With
    End With
    cat.Tables.Append myTbl
    Set cat = Nothing
    MsgBox "Tabela 'tblFiltr' została utworzona"
    Exit Sub
ErrorHandler:
    If Err.Number = -2147217857 Then
    cat.Tables.Delete "tblFiltr"
    Resume
    End If
    MsgBox Err.Number & ": " & Err.Description
End Sub


Example8

'---------------------wywołanie kwerendy z parametrami
Sub Execute_ParamQueryADOX()
    Dim cat As ADOX.Catalog
    Dim cmd As ADODB.Command
    Dim rst As ADODB.Recordset
    
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Northwind.mdb"
    
    Set cmd = New ADODB.Command
    Set cmd = cat.Procedures("Filtr faktur").Command
    
    ' specify a parameter value
    cmd.Parameters("[Forms]![Zamówienia]![IDzamówienia]") = 10258
    ' use the Execute method of the Command object to open the recordset
    Set rst = cmd.Execute
    ' return product names to the Immediate window
    Do Until rst.EOF
        Debug.Print rst(20).Name & ": " & rst(20) '20-sta kolumna
        rst.MoveNext
    Loop
    'wynik
    'NazwaProduktu: Chang
    'NazwaProduktu: Chef Anton 's Gumbo Mix
    'NazwaProduktu: Mascarpone Fabioli
    
    rst.Close
    
    Set rst = Nothing
    Set cmd = Nothing
    Set cat = Nothing
End Sub

Example9

'----------------kwerenda parametryczna - bez uzycia ADOX
Sub ExecuteParamQuery2()
    RunParamQueryNoADOX "C:\northwind.mdb", "Sprzedaż wg pracowników i krajów", #8/1/1996#, #8/31/1996#
End Sub
Sub RunParamQueryNoADOX(strDBPath As String, _
                        strQryName As String, _
                        varParamValue1 As Variant, _
                        varParamValue2 As Variant)
   Dim cnn As ADODB.Connection
   Dim cmd As ADODB.Command
   Dim rst As ADODB.Recordset
   Dim fld As ADODB.Field
   
   ' Open the connection
   Set cnn = New ADODB.Connection
   With cnn
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Open strDBPath
   End With

   ' Create the command
   Set cmd = New ADODB.Command
   Set cmd.ActiveConnection = cnn
   With cmd
      .Properties("Jet OLEDB:Stored Query") = True
      .CommandText = strQryName
   End With
   
   ' Execute the command and pass in the values for the parameters.
   Set rst = New ADODB.Recordset
   Set rst = cmd.Execute(Parameters:=Array(varParamValue1, varParamValue2))
      
   With rst
      ' Display the records in the Immediate pane.
      Do While Not rst.EOF
         For Each fld In .Fields
            Debug.Print fld.Value & ";";
         Next
         Debug.Print
         .MoveNext
      Loop
   
      ' Close the Recordset object.
      .Close
   End With
   
   ' Close connection and destroy object variables.
   cnn.Close
   Set rst = Nothing
   Set cnn = Nothing
End Sub

Example10

Sub polaczenieExcel()
'laczy sie z plikiem Excela
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\ADOTest.xls;Extended Properties='Excel 8.0;HDR=Yes'
On Error GoTo blad
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    Dim rs As New ADODB.Recordset
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\ADOTest.xls;Extended Properties='Excel 8.0;HDR=Yes'"
        MsgBox "Połączenie utworzone"
        'rs.Source = "SELECT * FROM [Arkusz1$]"
        'rs.Source = "SELECT imie FROM [Arkusz1$]"
        rs.Source = "SELECT * from ludzie" 'zakres nazwany
        rs.Open , conn
            Arkusz4.Range("a1").CopyFromRecordset rs
        rs.Close
        Set rs = Nothing
    conn.Close
    Set conn = Nothing
    MsgBox "Połączenie utracone"
    Exit Sub
blad:
    MsgBox Err.Number & ": " & Err.Description

End Sub

Connect VBA with MySQL - step by step

Download MySQL Connector

  1. http://www.mysql.com/downloads/
  2. Select specific file with MySQL Connectors (JDBC, ODBC, .Net, etc.)
  3. Install this file

Setup in Administration Panel

Go to Administration Tools -> ODBC

Panel.jpg


Select System DSN card

Panel2a.jpg


Select specific connection

Panel3.jpg


Configure connection

(if you need ip adress go to cmd and write ping your_domain)

Panel4a.jpg

Test it!

If all is OK lets go to VBA!

Panel5.jpg

Connect by VBA (using code)

Dim oConn As ADODB.Connection 'create variable to catch connection
Sub Przycisk4_Click()

    Set oConn = New ADODB.Connection
    Set rs = CreateObject("ADODB.Recordset") 'we need object to catch query
    SQLStr = "SELECT * FROM abc" 'your query
    
    'setup connection in vba
    oConn.Open "DRIVER={MySQL ODBC 5.2 Unicode Driver};" & _
        "SERVER=localhost;" & _
        "DATABASE=test;" & _
        "USER=root;" & _
        "PASSWORD=root;" & _
        "Option=3"
        
    rs.Open SQLStr, oConn, adOpenStatic 'flags to object

    Dim myArray()

    myArray = rs.GetRows()

    kolumner = UBound(myArray, 1)
    rader = UBound(myArray, 2)

    For K = 0 To kolumner ' Using For loop data are displayed
        Range("a5").Offset(0, K).Value = rs.Fields(K).Name
        For R = 0 To rader
           Range("A5").Offset(R + 1, K).Value = myArray(K, R)
        Next
    Next

    rs.Close
    Set rs = Nothing
    oConn.Close
    Set oConn = Nothing
        
    
End Sub
Retrieved from ‘https://training-course-material.com/index.php?title=ADO_Database_Connection&oldid=24099’