打开/关闭ADO连接

Question

我试图从Access导入数据到Excel。 Access表中有四列：日期，时间，坦克，评论。在导入Time和Tank列时，我根据日期对它们进行排序。此外，我将它们分别导入，以便我可以交换列时间，坦克到坦克，时间。在编程中，我必须关闭并打开ADO连接。我想通过避免关闭连接并重新打开它来使程序更高效。任何建议/解决方案？谢谢。

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 

Answer 1

记录列在返回您的Select sta的顺序tement。所以，如果你想Tank是第一，然后先列出这样说：TankSelect = "SELECT u.Tank, u.Time ...你的代码的其余部分

简单的例子：

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 

TankSelect = "SELECT u.Tank, u.Time" & vbCrLf & _ 
      "FROM UnitOneRouting AS u" & vbCrLf & _ 
      "WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _ 
      "ORDER BY u.Tank;" 

rs.Open TankSelect, cn, adOpenStatic, adLockOptimistic, adCmdText 

TankRange.CopyFromRecordset rs 

rs.Close 
Set rs = Nothing 
cn.Close 
Set cn = Nothing 

---

您还可以通过返回特定字段的数组使用GetRows。这也允许你操作你的结果，而不必对数据库进行任何其他调用。这里有一个例子：

Dim FieldsToSelect(0 To 1) As Variant 
FieldsToSelect(0) = "TankVal" 
FieldsToSelect(1) = "TimeVal" 

With rs 
    TankSelect = "SELECT u.Tank AS TankVal, u.Time AS TimeVal" & vbCrLf & _ 
       "FROM UnitOneRouting AS u" & vbCrLf & _ 
       "WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _ 
       "ORDER BY u.Tank;" 

    .Open TankSelect, cn, adOpenStatic, adLockOptimistic, adCmdText 

    ResultsArray = .GetRows(Fields:=FieldsToSelect) 
End With 

rs.Close 
Set rs = Nothing 
cn.Close 
Set cn = Nothing 

'Do what you want with array of results 

的ResultsArray将列出顺序磁场，导致您在FieldsToSelect

---

当然声明它们，另一种选择是通过你们的记录和输出回路特定的字段转换为特定的单元

Answer 2

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.ConnectionString = "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 

我没有测试过这一点，但我所做的只是去掉cn.Close和改变它，所以它只会更改连接字符串（不知道这是正确的属性，但我敢肯定，它有一些aproperty）。然后我离开了结尾。

Answer 3

有几种情况可以在你的榜样加以改进：
1）你并不需要关闭连接到运行另一个查询（打开不同的记录），
2）你从同一个表使用相同的WHERE条件选择两次，我会好得多 在一个查询中同时选择和填充两个小区一气呵成，
3）不使用SQL参数是一个不好的编程习惯， 例

Sub ADOImportFromAccessTable() 

    Dim DBFullName As String 
    Dim TankRange As Range 
    Dim Cmd1 As ADODB.Command 
    Dim Param1 As ADODB.Parameter 
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer 

    DBFullName = "U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" 
    Worksheets("TankHours").Activate 
    Set TankRange = Range("C5") 

    Set cn = New ADODB.Connection 
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFullName & ";" 

    Set Cmd1 = New ADODB.Command 

    Cmd1.CommandText = "select Tank, Time from UnitOneRouting where Date = ?" 
    Cmd1.CommandType = adCmdText 
    Cmd1.ActiveConnection = cn 

    Set Param1 = Cmd1.CreateParameter("date1", adDate, adParamInput, , Range("B2").Value) 
    Cmd1.Parameters.Append Param1 

    Set rs = Cmd1.Execute() 

    TankRange.CopyFromRecordset rs, 1 ' copy just one row, ignore rest if there are more 

    rs.Close 
    Set rs = Nothing 
    cn.Close 
    Set cn = Nothing 

End Sub