VBA/Excel/Access/Word/Access/ADODB.Connection

Connection to database

 
Sub ConnectToDatabase()
  Dim Connection As ADODB.Connection
  On Error GoTo Except
    Set Connection = New ADODB.Connection
    Connection.Provider = "Microsoft.Jet.OLEDB.4.0"
    Connection.ConnectionString = "data source=C:\nwind.mdb"
    Connection.Mode = adModeReadWrite
    Connection.Open
    MsgBox "Connected via " & Connection.Provider & " OLE DB Provider!", vbInformation
    Exit Sub
Except:
    MsgBox Err.Description, vbCritical
End Sub

Connect to current database

 
Sub ConnecttoSameDB()
    Dim conn As ADODB.Connection
    Set conn = CurrentProject.Connection
    MsgBox "Connected to " & conn.Provider
End Sub

Connect to database with user name and password

 
Sub addUser() 
   Dim myConnection As ADOX.Catalog
   Dim newUser As ADOX.User
   Dim userName As String
   Dim newPassword As String
   
   Set myConnection = New ADOX.Catalog
   myConnection.ActiveConnection = _
        "Provider = Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\r.mdb;" & _
        "Jet OLEDB:System database=C:\r.mdw;" & _
        "User id=john;Password=;"
   Set newUser = New ADOX.User
   newUser.Name = userName
   myConnection.Users.Append newUser
   myConnection.Users(newUser.Name).changePassword "", newPassword
End Sub

Connect to databse through URL

 
Sub ConnectToURL()
  On Error GoTo Except
    Dim Connection As New ADODB.Connection
    Connection.Provider = "Microsoft.Jet.OLEDB.4.0"
    Const URL = "http://localhost/access/nwind.mdb"
    Connection.ConnectionString = "URL=" & URL
    Connection.Mode = adModeReadWrite
    Connection.Open
    MsgBox "Connected via " & Connection.Provider & _
        " OLE DB Provider!", vbInformation
    Exit Sub
Except:
    MsgBox Err.Description, vbCritical
End Sub

Creating a Connection Object

 
Sub CreateConnection()
    "Declare and instantiate the connection
    Dim cnn As ADODB.Connection
    Set cnn = New ADODB.Connection
    "Open the connection
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Persist Security Info=False;" & _
    "User ID=Admin;" & _
    "Data Source=" & CurrentProject.Path & _
        "\YourDb.accdb;"
    cnn.Close
    Set cnn = Nothing
End Sub

open up a schema with a provider to look at all the database objects

 
Sub ReadSchema()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set conn = New ADODB.Connection
    "Jet
    "With conn
    "    .Provider = "Microsoft.Jet.OLEDB.4.0"
    "    .ConnectionString = "Data source=" & App.Path & "\sample.mdb"
    "    .Open
    "End With
    "SQL Server
    With conn
        .Provider = "SQLOLEDB"
        .ConnectionString = "data source=batman;user id=sa;initial catalog=Northwind"
        .Open
    End With
    Set rst = conn.OpenSchema(adSchemaTables)
    Do Until rst.EOF
        Debug.Print "Catalog: " & rst!Table_Catalog
        Debug.Print "Schema: " & rst!Table_Schema
        Debug.Print "Table Name: " & rst!Table_Name
        Debug.Print "Type: " & rst!Table_Type
        Debug.Print "Date Created: " & rst!Date_Created
        Debug.Print "Date Modified" & rst!Date_Modified
        Debug.Print
        rst.MoveNext
    Loop
    rst.Close
    conn.Close
    
    Set rst = Nothing
    Set conn = Nothing
End Sub

The Errors Collection

 
Public Sub errorTest()
    Dim myConn As ADODB.Connection
    Dim myErr As ADODB.Error
    Dim strError As String
    On Error GoTo myHandler
    Set myConn = New ADODB.Connection
    myConn.Open "nothing"
    Set myConn = Nothing
    Exit Sub
myHandler:
    For Each myErr In myConn.Errors
        strError = "Error #" & Err.Number & vbCr & _
            "   " & myErr.Description & vbCr & _
            "   (Source: " & myErr.Source & ")" & vbCr & _
            "   (SQL State: " & myErr.SQLState & ")" & vbCr & _
            "   (NativeError: " & myErr.NativeError & ")" & vbCr
        If myErr.HelpFile = "" Then
            strError = strError & "   No Help file available"
        Else
            strError = strError & _
               "   (HelpFile: " & myErr.HelpFile & ")" & vbCr & _
               "   (HelpContext: " & myErr.HelpContext & ")" & _
               vbCr & vbCr
        End If
        Debug.Print strError
    Next
    Resume Next
End Sub