Snasui Excel Forum

Code: Select all

Sub GetData01()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String
Dim B As String
B = Format(Year(Date), "0000") & Format(Month(Date) - 1, "00")
    strFilePath = "D:\Adhoc_2015\ID0060_072015\base2013\OTHERLOAN_2013.mdb"
    Set cnn = New ADODB.Connection
    Set rs = New ADODB.Recordset
     
For I = 1 To 12
    Sheets("Sheet" & I).Range("AKKE" & I).ClearContents
 
    'sQRY = "SELECT tblData.* FROM tblData"
'    sQRY = "NEWCUST"
sQRY = I
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strFilePath & ";"
          rs.CursorLocation = adUseClient
    rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
    Application.ScreenUpdating = False
     Sheets("Sheet" & I).Range("AKKE" & I).CopyFromRecordset rs

    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
Next I
    Exit Sub

Code: Select all

Sub GetData01()
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sQRY As String
    Dim strFilePath As String
    Dim B As String
    B = Format(Year(Date), "0000") & Format(Month(Date) - 1, "00")
    strFilePath = "E:\New folder (6)\sample.mdb"
    Set cnn = New ADODB.Connection
    Set rs = New ADODB.Recordset
         
    For I = 1 To 3
        Sheets("Sheet" & I).Range("AKKE" & I).ClearContents
       'sQRY = "SELECT tblData.* FROM tblData"
       'sQRY = "NEWCUST"
        sQRY = I
        cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & strFilePath & ";"
              rs.CursorLocation = adUseClient
        rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
        Application.ScreenUpdating = False
        Sheets("Sheet" & I).Range("AKKE" & I).CopyFromRecordset rs
        cnn.Close
    Next I
    Set cnn = Nothing
    rs.Close
    set rs = Nothing
    Application.ScreenUpdating = True
End Sub