Display a simple Access Database onClick

[bobdole22]

Hey everyone. I just started my new job today and I desperately need some help. My boss wants a VBA function to display an Access database. Right now, I'm starting with a simple 3 line database.

I read through the "How to get the best help possible quickly" thread. I did a search and didn't see anything over this topic. I also, am using Excel 2007.

Here is what I have:

Sub Show()
    'C:\Users\zachk\Desktop\Test.accdb

    Dim cn As Object  
    Dim rs As Object    
    Dim strSql As String  
    Dim strConnection As String    

    Set cn = CreateObject("ADODB.Connection")    
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _    "Data Source=C:\Users\zachk\Desktop\Test.accdb"    
    strSql = "SELECT ID FROM Test;"   

   cn.Open strConnection    
   Set rs = cn.Execute(strSql)    
   MsgBox rs.Fields(0) & " rows in MyTable"

    rs.Close    
    Set rs = Nothing    
    cn.Close    
    Set cn = Nothing
    End Sub

It works. Connects correctly. When I click the button, it runs show correctly. But is just alerting "3 rows in MyTable". I need it to display all the rows. I'm new to VBA but know other programming languages pretty well. Please help me out here, I've been looking for hours.

[Kenneth Hobs]

You are just getting the first fields value.

Review these examples. http://www.erlandsendata.no/english/...php?t=envbadac
in particular see: http://www.erlandsendata.no/english/...badacimportado

[bobdole22]

Great! I actually got the code to work! Only problem is it works for .mdb files only. My entire office is saving as .accdb >:]

Any way I can fix this?


Here is my code:

Option Explicit
Sub Access_Data()
    'Requires reference to Microsoft ActiveX Data Objects xx Library
    
    Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
    Dim MyConn, sSQL As String


    Dim Rw As Long, Col As Long, c As Long
    Dim MyField, Location As Range


    'Set destination
    Set Location = [B2]
    'Set source
    MyConn = "C:\Users\zachk\Desktop\d b.mdb"
    'Create query
    sSQL = "SELECT Table1.Data, Table1.Count FROM Table1;"


    'Create RecordSet
    Set Cn = New ADODB.Connection
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
        Set Rs = .Execute(sSQL)
    End With


    'Write RecordSet to results area
    Rw = Location.Row
    Col = Location.Column
    c = Col
    Do Until Rs.EOF
        For Each MyField In Rs.Fields
            Cells(Rw, c) = MyField
            c = c + 1
        Next MyField
        Rs.MoveNext
        Rw = Rw + 1
        c = Col
    Loop
Set Location = Nothing
Set Cn = Nothing
  End Sub

[Kenneth Hobs]

Set the correct connect string. http://www.connectionstrings.com/access/

[bobdole22]

Where do I place that code? This is giving me an error:

Option ExplicitSub Access_Data()
'Requires reference to Microsoft ActiveX Data Objects xx Library

Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
Dim MyConn, sSQL As String


Dim Rw As Long, Col As Long, c As Long
Dim MyField, Location As Range


'Set destination
Set Location = [B2]

'Set source
MyConn = "C:\Users\zachk\Desktop\Strats 2011.01.accdb"
'Create query
sSQL = "SELECT * FROM Data_All;"

'Create RecordSet
Set Cn = New ADODB.Connection
With Cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
'Persist Security Info=False;
Set Rs = .Execute(sSQL)
End With


'Write RecordSet to results area
Rw = Location.Row
Col = Location.Column
c = Col
Do Until Rs.EOF
For Each MyField In Rs.Fields
Cells(Rw, c) = MyField
c = c + 1
Next MyField
Rs.MoveNext
Rw = Rw + 1
c = Col
Loop
Set Location = Nothing
Set Cn = Nothing
End Sub

[bobdole22]

Option Explicit
Sub Access_Data()
'Requires reference to Microsoft ActiveX Data Objects xx Library

Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
Dim MyConn, sSQL As String


Dim Rw As Long, Col As Long, c As Long
Dim MyField, Location As Range


'Set destination
Set Location = [B4]
'Set source



'MyConn = "C:\Users\zachk\Desktop\Strats 2011.01.accdb"
MyConn = "C:\Users\zachk\Desktop\Strats 2011.01.accdb"
'Create query
sSQL = "SELECT Trust FROM Data_All WHERE BondIssue='C03B1T';"
'Should display BSFC 2003Apr

'Create RecordSet
Set Cn = New ADODB.Connection
With Cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
Set Rs = .Execute(sSQL)
End With

'Need some way to write this to excel <----------------------------


End Sub

[Kenneth Hobs]

I am not sure why you did two posts of code in quote tags.

Here is an example connection string:

'http://www.vbaexpress.com/forum/showthread.php?t=38654
Sub AccessToExcel()
    Dim dbConnection  As ADODB.Connection
    Dim dbRecordset   As ADODB.RecordSet
    Dim dbFileName    As String
    Dim strSQL        As String
    Dim DestinationSheet As Worksheet
    Dim mtxData As Variant
     
    Set dbConnection = New ADODB.Connection
    Set dbRecordset = New ADODB.RecordSet
    Set DestinationSheet = Worksheets("Sheet2")
     
    dbFileName = "C:\Documents and Settings\ADRY_7258\My Documents\Test_Access_db.accdb"
    dbConnection.Provider = "Microsoft.ACE.OLEDB.12.0;Data Source=" & dbFileName _
    & ";Persist Security Info=False;"
     
    strSQL = "SELECT Test_Access_db.* from Test_Access_db where Employee_name = 'Bill'"
     
    DestinationSheet.Cells.Clear
     
    With dbConnection
        .Open
        .CursorLocation = adUseClient
    End With
     
    With dbRecordset
        .Open strSQL, dbConnection
        Set .ActiveConnection = Nothing
    End With
     
    mtxData = dbRecordset.GetRows
    DestinationSheet.Range("A1:C1").Value = Array("Employee ID", "Employee Name", "Employee Salary")
    DestinationSheet.Range("A2").Resize(UBound(mtxData, 1) - UBound(mtxData, 1) + 1, UBound(mtxData, 2) - UBound(mtxData, 2) + 1) = mtxData
     
    dbRecordset.Close
    dbConnection.Close
     
    Set dbRecordset = Nothing
    Set dbConnection = Nothing
    Set DestinationSheet = Nothing
End Sub