I am trying to import data from Access to Excel. There are four columns in the Access table: Date, Time, Tank, Comments. On importing the Time and Tank columns, I sort them based on date. Additionally, I import them separately so I can swap the column order form Time, Tank to Tank, Time. In the programming I have to close and open the ADO connection for that. I want to make the program more efficient by avoiding closing the connection and having to open it again. Any suggestions/solutions? Thanks.
Sub ADOImportFromAccessTable()
Dim DBFullName As String
Dim TankRange As Range
Dim TimeRange As Range
Dim RpDate
Dim TankSelect As String
Dim TimeSelect As String
Dim r As Long
DBFullName = "U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb"
Worksheets("TankHours").Activate
Set TankRange = Range("C5")
Set TimeRange = Range("D5")
Set RpDate = Range("B2").Cells
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TankRange = TankRange.Cells(1, 1)
Set TimeRange = TimeRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
"U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
' filter rows based on date
TankSelect = "SELECT u.Tank" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Time, u.Tank;"
.Open TankSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
TankRange.CopyFromRecordset rs
'End With
'rs.Close
' Set rs = Nothing
cn.Close
' Set cn = Nothing
' Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
"U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" & ";"
'Set rs = New ADODB.Recordset
' With rs
'' open the recordset
'' filter rows based on date
TimeSelect = "SELECT u.Time" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Time, u.Tank;"
.Open TimeSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
TimeRange.CopyFromRecordset rs
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub