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


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

UDL files

Example1

<syntaxhighlight lang="vb">

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

</syntaxhighlight>

Example2

<syntaxhighlight lang="vb">


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

</syntaxhighlight>

Example3

<syntaxhighlight lang="vb">


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


</syntaxhighlight>

Example4

<syntaxhighlight lang="vb">


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

</syntaxhighlight>

Example5

<syntaxhighlight lang="vb">


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


</syntaxhighlight>

Example6

<syntaxhighlight lang="vb">


'--------- 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


</syntaxhighlight>

Example7

<syntaxhighlight lang="vb">


'------------------------------ 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

</syntaxhighlight>


Example8

<syntaxhighlight lang="vb">

'---------------------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


</syntaxhighlight>

Example9

<syntaxhighlight lang="vb">


'----------------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


</syntaxhighlight>

Example10

<syntaxhighlight lang="vb">


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 </syntaxhighlight>

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


Select System DSN card


Select specific connection


Configure connection

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

Test it!

If all is OK lets go to VBA!

Connect by VBA (using code)

<syntaxhighlight lang="vb"> 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

</syntaxhighlight>

Retrieved from "https://training-course-material.com/index.php?title=ADO_Database_Connection&oldid=24099"