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

Connection to database

   <source lang="vb">

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

</source>
   
  

Connect to current database

   <source lang="vb">

Sub ConnecttoSameDB()

   Dim conn As ADODB.Connection
   Set conn = CurrentProject.Connection
   MsgBox "Connected to " & conn.Provider

End Sub

</source>
   
  

Connect to database with user name and password

   <source lang="vb">

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

</source>
   
  

Connect to databse through URL

   <source lang="vb">

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

</source>
   
  

Creating a Connection Object

   <source lang="vb">

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

</source>
   
  

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

   <source lang="vb">

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

</source>
   
  

The Errors Collection

   <source lang="vb">

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

</source>