ADO Database Connection
From Training Material
| Courses Offered |
|---|
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
Contents
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
- http://www.mysql.com/downloads/
- Select specific file with MySQL Connectors (JDBC, ODBC, .Net, etc.)
- 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)
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
