vba 打开/关闭 ADO 连接
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/26105927/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Open/Close ADO Connection
提问by Kish
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.
我正在尝试将数据从 Access 导入 Excel。Access 表中有四列：Date、Time、Tank、Comments。在导入 Time 和 Tank 列时，我根据日期对它们进行排序。此外，我分别导入它们，以便我可以交换列订单形式 Time、Tank 到 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
采纳答案by Portland Runner
Recordset columns are returned in the order of your Selectstatement. So if you want Tankto be first then list it first like this: TankSelect = "SELECT u.Tank, u.Time... rest of your code
记录集列按您的Select语句的顺序返回。所以如果你想Tank成为第一个，那么首先像这样列出它：TankSelect = "SELECT u.Tank, u.Time......其余的代码
Simple example:
简单的例子：
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
You can also return specific fields to an array by using GetRows. This also allows you to manipulate your results without having to make any other call to the database. Here is an example:
您还可以使用 将特定字段返回到数组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
The ResultsArraywill list the field results in the order that you declare them in FieldsToSelect
该ResultsArray会列出的顺序磁场，导致您在声明它们FieldsToSelect
Of course, another option is to just loop through your recordset and output the specific fields into specific cells.
当然，另一种选择是循环遍历您的记录集并将特定字段输出到特定单元格中。
回答by DJ Burb
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
I haven't tested this, but all I did was remove the cn.Close and changed it, so it will just change the connection string (not sure if that is the right property, but I'm sure there is aproperty for it). Then I left the close it at the end.
我还没有测试过这个，但我所做的只是删除了 cn.Close 并更改了它，所以它只会更改连接字符串（不确定这是否是正确的属性，但我确定它有属性） . 然后我最后离开了关闭它。
回答by user3075118
Several things can be improved in your example:
1) You don't need to close connection to run another query (open different recordset),
2) You select from the same table using the same where condition twice, I would be much better
to select both in one query and populate two cells in one go,
3) Not using SQL parameters is a bad programming practice,
Example
在您的示例中可以改进几件事：
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
