MyTetra Share
Делитесь знаниями!
izБорей
28.05.2019
06:17
Текстовые метки: izБорей, Recordset, OpenRecordset
Раздел: !Закладки - VBA - Access

Sub dbOpenForwardOnlyX()


Dim dbsNorthwind As dao.DATABASE

Dim rstEmployees As Recordset

Dim fldLoop As Field


Set dbsNorthwind = OpenDatabase(<path_to_folder_or_file>.accdb")

' Открывает набор записей с последовательным доступом.

' Для перемещения по этому объекту Recordset могут

' использоваться только методы MoveNext и Move.

Set rstEmployees = dbsNorthwind.OpenRecordset("point_fab", dbOpenForwardOnly)


With rstEmployees

Debug.Print "Набора записей с последовательным доступом: " & .Name & ", Updatable = " & .Updatable


Debug.Print " Field - DataUpdatable"

' Отображает семейство Fields, печатает свойства Name

' и DataUpdatable каждого объекта Field.

For Each fldLoop In .Fields

Debug.Print " " & fldLoop.Name & " - " _

& fldLoop.DataUpdatable & " - " _

& fldLoop.Type & " - " _

& fldLoop.ValidationText

Next fldLoop


Debug.Print " Данные"

' Печатает данные из набора записей.

Do While Not .EOF

Debug.Print " " & !ДАТА & " " & !ПЛАН & " " & !Итог

.MoveNext

Loop

'ДАТА № Вход_Выход Утро_Вечер Утро_Вечер1 Обьем ПЛАН Итог Вх1 Вх2 минуты ОПИСАНИЕ ПОТЕРЬ EQ_TO


.Close

End With

dbsNorthwind.Close

End Sub





Option Compare Database


Sub dbOpenForwardOnlyX()


Dim dbsNorthwind As dao.DATABASE

Dim rstEmployees As Recordset

Dim fldLoop As Field


Set dbsNorthwind = OpenDatabase("<path_to_folder_or_file>.mdb")

' Открывает набор записей с последовательным доступом.

' Для перемещения по этому объекту Recordset могут

' использоваться только методы MoveNext и Move.

Set rstEmployees = dbsNorthwind.OpenRecordset("Сотрудники", dbOpenForwardOnly)


With rstEmployees

Debug.Print "Набора записей с последовательным доступом: " & .Name & ", Updatable = " & .Updatable


Debug.Print " Field - DataUpdatable"

' Отображает семейство Fields, печатает свойства Name

' и DataUpdatable каждого объекта Field.

For Each fldLoop In .Fields

Debug.Print " " & fldLoop.Name & " - " _

& fldLoop.DataUpdatable & " - " _

& fldLoop.Type & " - " _

& fldLoop.ValidationText

Next fldLoop


Debug.Print " Данные"

' Печатает данные из набора записей.

Do While Not .EOF

Debug.Print " " & !Имя & " " & !Фамилия

.MoveNext

Loop


.Close

End With

dbsNorthwind.Close

End Sub


Sub BB()


''''''''''''''''''''''''''''''''''''''''''''''''''''

'Системные предупреждения - Отключить | Включить

DoCmd.SetWarnings False


Application.SetOption "Confirm Action Queries", 0

Application.SetOption "Confirm Document Deletions", 0

Application.SetOption "Confirm Record Changes", 0

''''''''''''''''''''''''''''''''''''''''''''''''''''


Dim bd As dao.DATABASE, bdt As dao.DATABASE

Dim tabl As Recordset

Dim tabl_t As Recordset

Dim pole As Field

Dim i As Byte

Set bd = OpenDatabase("<path_to_folder_or_file>.mdb") 'CurrentDb

Set bdt = OpenDatabase("<path_to_folder_or_file>.mdb")

t = Timer


' Set tabl = bd.OpenRecordset("SELECT zDPU.*, zDPU.Дата FROM zDPU ORDER BY zDPU.Дата;", dbOpenDynaset) 'откуда читаем

Set tabl = bd.OpenRecordset("SELECT DPU.*, DPU.Дата FROM DPU ORDER BY DPU.Дата;", dbOpenDynaset) 'откуда читаем

t = Timer - t

Debug.Print t

t = Timer


Set tabl_t = bdt.OpenRecordset("SELECT DPU.* FROM DPU;", dbOpenDynaset) 'куда пишем

t = Timer - t

Debug.Print t


'For Each pole In tabl.Fields 'перебрать все поля

'MsgBox pole.Name

'Next pole

t = Timer

With tabl

While Not .EOF 'перечитать все записи

tabl_t.AddNew

' tt = Timer


'создать новую запись в таблице для записи

For i = 0 To .Fields.Count - 1 'перебрать все поля

'MsgBox .Fields(i).Name

tabl_t.Fields(i) = .Fields(i)

Next i

tabl_t.Update 'сохранить новую запись в таблице для записи

.MoveNext

j = j + 1

' tt = Timer - tt

' Debug.Print j & " " & tt


'Exit Sub

Wend

End With

t = Timer - t

Debug.Print t

''''''''''''''''''''''''''''''''''''''''''''''''''''

' Application.SetOption "Confirm Action Queries", 1

' Application.SetOption "Confirm Document Deletions", 1

' Application.SetOption "Confirm Record Changes", 1

DoCmd.SetWarnings True ' ... и включили обратно на случай если понадобятся.

''''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub



Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования