ADO Database Connection
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
- 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)
<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>