excel vba for access to repeat c/p

[iP_123]

Hi.
I not acutely proficient when it comes to programming but upon research I was able to come accross the below code that sometwhat fit my purpose. The code copys data in a TABLE in access and paste in an excel worksheet called Sheet1 starting from cell b1. Is it possible to have the code repeat this process by copying data from several tables in access (say TAbLE2, TABLE3, ...) and paste in the same workbook on Sheet2, Sheet3...? The code is run from excel.
I will glady appreciate the help

Sub GetData()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String

    strFilePath = "C:\DatabaseFolder\MyDatabase.accdb"   
    Set cnn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    Sheet1.Range("DataRange").ClearContents
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strFilePath & ";"
    sQRY = "SELECT * FROM TABLE1"
    rs.CursorLocation = adUseClient
    rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
    Application.ScreenUpdating = False
    Sheet1.Range("B2").CopyFromRecordset rs
    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
    Exit Sub
End Sub

 

[Jerry Sullivan]

Hi iP_123,

Yes, you can step through a list of tables and target sheets.

This code is untested, but this is the gist of one way to do that...

Sub GetData()
 Dim cnn As ADODB.Connection
 Dim rs As ADODB.Recordset
 Dim sQRY As String, sTableName As String
 Dim lCounter As Long
 Dim vSourceTables As Variant, vTargetSheets As Variant
 Dim wksTarget As Worksheet
 
 Const strFilePath As String = "C:\DatabaseFolder\MyDatabase.accdb"
 
 Application.ScreenUpdating = False
 
 vSourceTables = Split("Table1,Table2,Table3", ",")
 vTargetSheets = Split("Sheet1,Sheet2,Sheet3", ",")
 
 Set cnn = New ADODB.Connection
 Set rs = New ADODB.Recordset
 
 For lCounter = LBound(vTargetSheets) To UBound(vTargetSheets)
   Set wksTarget = ThisWorkbook.Sheets(vTargetSheets(lCounter))
   sTableName = vSourceTables(lCounter)
   
   wksTarget.Range("DataRange").ClearContents
   cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & strFilePath & ";"
   sQRY = "SELECT * FROM " & sTableName
 
   rs.CursorLocation = adUseClient
   rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
 
   wksTarget.Range("B2").CopyFromRecordset rs
 Next lCounter
 
 Application.ScreenUpdating = True
 
 rs.Close
 Set rs = Nothing
 cnn.Close
 Set cnn = Nothing
End Sub

If your objects were really named Table1,2,3 and Sheet1,2,3 the could be simplified to just use "Table" & lCounter, but that won't work as soon as you have more typical table names.

 

[Fazza]

consider similar though without recordset object. modify as required. [ I tested using ACE.OLEDB.12.0 ]

Sub GetData()


    Dim i As Long
    Dim cnn As ADODB.Connection
    Dim strFilePath As String


    Dim aTableNames As Variant
    Dim aSheetNames As Variant
    '--------------------------------
    aTableNames = Array("Table1", "Table2", "Table3")
    aSheetNames = Array("Sheet1", "Sheet2", "Sheet3")
    strFilePath = "C:\DatabaseFolder\MyDatabase.accdb"
    
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath & ";"
             
    For i = LBound(aTableNames) To UBound(aTableNames)
        Worksheets(aSheetNames(i)).Range("B1").CopyFromRecordset cnn.Execute("SELECT * FROM " & aTableNames(i))
    Next i
    
    cnn.Close
    Set cnn = Nothing
    
End Sub

 

[iP_123]

Thank you Jerry & Fazza for the assistance. Much appreciated.

You helped me a Great deal!

iP_123