ADO Database Connection

The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

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

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

ADO Database Connection

Contents

Example1

Example2

Example3

Example4

Example5

Example6

Example7

Example8

Example9

Example10

Connect VBA with MySQL - step by step

Download MySQL Connector

Setup in Administration Panel

Go to Administration Tools -> ODBC

Select System DSN card

Select specific connection

Configure connection

Test it!

Connect by VBA (using code)

Navigation menu

Personal tools

Namespaces

Variants

Views

Search

Opportunities

Navigation

Tools