Открыть/закрыть Соединение ADO

Question

Я пытаюсь импортировать данные из Access в Excel. В таблице Access есть четыре столбца: Дата, Время, Танк, Комментарии. При импорте столбцов 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

Recordset столбцы возвращаются в порядок вашего 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 и изменил его, так что это будет просто изменить строку подключения (не уверен, если это право собственности, но Я уверен, что для этого есть возможность). Затем я оставил его в конце.

Answer 3

Некоторые вещи могут быть улучшены в вашем примере:
1) Вам не нужно, чтобы закрыть соединение, чтобы запустить другой запрос (открыть другую записей),
2) Вы выбираете из той же таблицы, используя тот же, где условие в два раза, я был бы намного лучше выбрать как в одном запросе и заполнить две ячейки на одном дыхании,
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