Cesar Chew at 18:38, 25 November 2014

2014-11-25T18:38:03Z

New page

[[Category:PL]]
[[Category:VBA]]

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

[[File:Add_ADO_Library.JPG]]

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

[[File:panel.jpg]]

==== Select System DSN card ====

[[File:panel2a.jpg]]

==== Select specific connection ====

[[File:panel3.jpg]]

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

[[File:panel4a.jpg]]

==== Test it! ====
If all is OK lets go to VBA!

[[File:panel5.jpg]]

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

ADO Database Connection - Revision history

Cesar Chew at 18:38, 25 November 2014