Question

我正在尝试将数据从Access导入Excel。 Access表中有四列：Date，Time，Tank，Comments。在导入Time和Tank列时，我会根据日期对它们进行排序。另外，我单独导入它们，以便我可以将列顺序表格Time，Tank to Tank，Time交换。在编程中，我必须关闭并打开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

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并更改它，所以它只会更改连接字符串（不确定这是否是正确的属性，但我＆＃39; m确定它有适合它）。然后我在最后离开了它。

Answer 2

在您的示例中可以改进几件事：
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

Answer 3

Recordset列按照Select语句的顺序返回。因此，如果您希望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

中声明的顺序列出字段结果

当然，另一种选择是循环遍历记录集并将特定字段输出到特定单元格中。

打开/关闭ADO连接

3 个答案: