Я не успел откликнуться, а тема уже оказалось закрытой... А товарищ Djubocco чего-то замолчал... Но мой альтруистический порыв оказался сильнее - надо ж выручить человека! - поэтому сам возобновлю разговор.
Использование библиотеки ADO в данном случае не очень удачный выбор. В Access существуют собственные, гораздо более эффективные средства экспорта/импорта.
Вот код, исполняемый в Access, которым я сегодня за 2 минуты "всосал" xlsx-файл размером 18 мегайт, содержащий 400 тыс.строк х 11 столбцов:
Sub fastImport()
Access.Application.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Лист1", "C:\...\...\MyFile.xlsx", True EndSub
"Access.Application" указываю, чтобы было понятно, к чему привязываться, если код будет запускаться извне (из Excel или еще откуда). Внутри Access достаточно начать этот оператор с "DoCmd".
Я не успел откликнуться, а тема уже оказалось закрытой... А товарищ Djubocco чего-то замолчал... Но мой альтруистический порыв оказался сильнее - надо ж выручить человека! - поэтому сам возобновлю разговор.
Использование библиотеки ADO в данном случае не очень удачный выбор. В Access существуют собственные, гораздо более эффективные средства экспорта/импорта.
Вот код, исполняемый в Access, которым я сегодня за 2 минуты "всосал" xlsx-файл размером 18 мегайт, содержащий 400 тыс.строк х 11 столбцов:
Sub fastImport()
Access.Application.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Лист1", "C:\...\...\MyFile.xlsx", True EndSub
"Access.Application" указываю, чтобы было понятно, к чему привязываться, если код будет запускаться извне (из Excel или еще откуда). Внутри Access достаточно начать этот оператор с "DoCmd".Gustav
гораздо более эффективные средства экспорта/импорта.
У меня аналогичный пример 12 столбцов, 400000 строк, вес файла Excel 33 мегабайта плюс вставка данных в существующую таблицу занял порядка 97 секунд. Office 2016, 64bit. Но. И с ADODB не всё так плохо, кодом из Excel вставилось тоже самое в существующую таблицу в Access за 301 секунду
PublicSub InsertToTable() Const lastRow = 400000, lastCol = 12 Dim pCon AsNew ADODB.Connection, pRSet AsNew ADODB.Recordset, vData AsVariant Dim k AsLong, t AsSingle, i AsLong
t = Timer: k = 0
pCon.CursorLocation = adUseClient
pCon.Open "DBQ=c:\Projects\Database2 min.accdb;Driver={Microsoft Access Driver (*.mdb, *.accdb)};DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;ReadOnly=0;ExtendedAnsiSQL=1;"
pRSet.CursorLocation = adUseClient: pRSet.CursorType = adOpenStatic
pRSet.Open "Select * From forImport Where FLong1 Is Null", pCon, adOpenStatic, adLockOptimistic
vData = Range("A2").Resize(lastRow, lastCol).Value
pCon.BeginTrans For i = 1To lastRow
k = k + 1 If (k Mod10000) = 0ThenDebug.Print k: DoEvents
pRSet.AddNew
pRSet(0).Value = vData(i, 1)
pRSet(1).Value = vData(i, 2)
pRSet(2).Value = vData(i, 3)
pRSet(3).Value = vData(i, 4)
pRSet(4).Value = vData(i, 5)
pRSet(5).Value = vData(i, 6) '
pRSet(6).Value = vData(i, 7)
pRSet(7).Value = vData(i, 8)
pRSet(8).Value = vData(i, 9)
pRSet(9).Value = vData(i, 10)
pRSet(10).Value = vData(i, 11)
pRSet(11).Value = vData(i, 12) Next
pRSet.UpdateBatch: pCon.CommitTrans
pRSet.Close: pCon.Close
MsgBox Timer - t EndSub
Так что у автора закрытого топика скорее всего были индексы в таблице Access, что и приводило к таким "тормозам".
гораздо более эффективные средства экспорта/импорта.
У меня аналогичный пример 12 столбцов, 400000 строк, вес файла Excel 33 мегабайта плюс вставка данных в существующую таблицу занял порядка 97 секунд. Office 2016, 64bit. Но. И с ADODB не всё так плохо, кодом из Excel вставилось тоже самое в существующую таблицу в Access за 301 секунду
PublicSub InsertToTable() Const lastRow = 400000, lastCol = 12 Dim pCon AsNew ADODB.Connection, pRSet AsNew ADODB.Recordset, vData AsVariant Dim k AsLong, t AsSingle, i AsLong
t = Timer: k = 0
pCon.CursorLocation = adUseClient
pCon.Open "DBQ=c:\Projects\Database2 min.accdb;Driver={Microsoft Access Driver (*.mdb, *.accdb)};DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;ReadOnly=0;ExtendedAnsiSQL=1;"
pRSet.CursorLocation = adUseClient: pRSet.CursorType = adOpenStatic
pRSet.Open "Select * From forImport Where FLong1 Is Null", pCon, adOpenStatic, adLockOptimistic
vData = Range("A2").Resize(lastRow, lastCol).Value
pCon.BeginTrans For i = 1To lastRow
k = k + 1 If (k Mod10000) = 0ThenDebug.Print k: DoEvents
pRSet.AddNew
pRSet(0).Value = vData(i, 1)
pRSet(1).Value = vData(i, 2)
pRSet(2).Value = vData(i, 3)
pRSet(3).Value = vData(i, 4)
pRSet(4).Value = vData(i, 5)
pRSet(5).Value = vData(i, 6) '
pRSet(6).Value = vData(i, 7)
pRSet(7).Value = vData(i, 8)
pRSet(8).Value = vData(i, 9)
pRSet(9).Value = vData(i, 10)
pRSet(10).Value = vData(i, 11)
pRSet(11).Value = vData(i, 12) Next
pRSet.UpdateBatch: pCon.CommitTrans
pRSet.Close: pCon.Close
MsgBox Timer - t EndSub
Так что у автора закрытого топика скорее всего были индексы в таблице Access, что и приводило к таким "тормозам".anvg
если из экселя запустим, то как эксель узнает куда экспортировать, ну там имя базы, таблицы?
Ну, естественно, нужна предварительная подготовка. Типа CreateObject("Access.Application"), OpenDatabase и т.д. Просто открыть файл MDB или новый и писать в него (как в случае с ADO) - недостаточно, т.к. объект DoCmd доступен только в экземпляре Access.
P.S. Примерно такая минимальная болванка:
Sub runAccess() Set acApp = CreateObject("Access.Application")
acApp.OpenCurrentDatabase strFileName
Set acDoCmd = acApp.DoCmd
acDoCmd.TransferSpreadsheet 0, 9, "Лист1", "C:\...\...\MyFile.xlsx", True
если из экселя запустим, то как эксель узнает куда экспортировать, ну там имя базы, таблицы?
Ну, естественно, нужна предварительная подготовка. Типа CreateObject("Access.Application"), OpenDatabase и т.д. Просто открыть файл MDB или новый и писать в него (как в случае с ADO) - недостаточно, т.к. объект DoCmd доступен только в экземпляре Access.
P.S. Примерно такая минимальная болванка:
Sub runAccess() Set acApp = CreateObject("Access.Application")
acApp.OpenCurrentDatabase strFileName
Set acDoCmd = acApp.DoCmd
acDoCmd.TransferSpreadsheet 0, 9, "Лист1", "C:\...\...\MyFile.xlsx", True
Андрей, Костя, спасибо за коды. Пришлось связаться с Access. В принципе, привязал оба варианта. Пока пытаюсь дожать ADODB. Возникла проблема. Если имеем индексированное поле pRSet(3), и пытаемся туда записать дубль, возникает ошибка. При пошаговом просмотре обнаружил, что она возникает не в момент записи
pRSet(3).Value = vData(i, 4)
а в момент добавления новой
pRSet.AddNew
на следующей итерации, либо при попытке обновления. Соответственно вопрос - как удалить из рекордсета эту запись? Или как решить проблему?
Андрей, Костя, спасибо за коды. Пришлось связаться с Access. В принципе, привязал оба варианта. Пока пытаюсь дожать ADODB. Возникла проблема. Если имеем индексированное поле pRSet(3), и пытаемся туда записать дубль, возникает ошибка. При пошаговом просмотре обнаружил, что она возникает не в момент записи
pRSet(3).Value = vData(i, 4)
а в момент добавления новой
pRSet.AddNew
на следующей итерации, либо при попытке обновления. Соответственно вопрос - как удалить из рекордсета эту запись? Или как решить проблему?RAN
Быть или не быть, вот в чем загвоздка!
Сообщение отредактировал RAN - Четверг, 01.11.2018, 22:57
А зачем писать дубль - индекс судя по сообщению уникальный. Просто переписать значение в запись по этому индексу. Чтобы что-то посоветовать нужны детали. Проще, в рамках темы, запросом по полю индекса найти только новые уникальные и вставить их, а остальные для существующих - обновить данные. Удаление, по большому счёту ни к чему - лишнее время на перепостроение индексов в базе.
А зачем писать дубль - индекс судя по сообщению уникальный. Просто переписать значение в запись по этому индексу. Чтобы что-то посоветовать нужны детали. Проще, в рамках темы, запросом по полю индекса найти только новые уникальные и вставить их, а остальные для существующих - обновить данные. Удаление, по большому счёту ни к чему - лишнее время на перепостроение индексов в базе.anvg
Итак, возвращаясь к нашим баранам.. Была задача - перенести данные из файла Excel в таблицу Access, для новых записей создать папки, и проставить на них гиперссылки. Имена папок формируются из поля Код(счетчик). Проблема возникла с индексированным полем. Если в нем случайно оказыватся значение, имеющееся в таблице (ткнула девочка шаловливым пальчиком не в ту кнопку), возникают проблемы... Сделал, как советовал Сергей, на словаре (ибо ближе и понятней). Но, с большим удовольствием, изучу альтернативное решение.
' Dim pCon As New ADODB.Connection, pRSet As New ADODB.Recordset Dim pCon AsObject, pRSet AsObject Dim vData AsVariant, vvData AsVariant Dim k AsLong, i AsLong, j& Dim strCon$, ctrSQL$, strFields$, strF$ Dim sSavePath$ Dim oDic AsObject Dim inexColumn&, errCounter&
Set oDic = CreateObject("Scripting.Dictionary") Set pCon = CreateObject("ADODB.Connection") Set pRSet = CreateObject("ADODB.Recordset")
pCon.CursorLocation = 3' adUseClient
Do'While Not pRSet.EOF
oDic.Item(pRSet.Fields(pIndexName).Value) = oDic.Count
pRSet.MoveNext DoEvents LoopWhileNot pRSet.EOF
k = pRSet.Fields.Count - UBound(vData, 2)
For i = 2ToUBound(vData) IfNot oDic.Exists(vData(i, inexColumn)) Then
pRSet.AddNew For j = 1ToUBound(vData, 2)
pRSet(j + k - 1).Value = vData(i, j) ' код & гипер Next Else
errCounter = errCounter + 1 For j = 1ToUBound(vData, 2)
vvData(errCounter, j) = vData(i, j) Next EndIf Next
pRSet.UpdateBatch Do'While Not pRSet.BOF
If pRSet.EOF ThenExitDo
IfIsNull(pRSet.Fields(hypl).Value) Then
sSavePath = sSaveFolder & CStr(pRSet![Код].Value) ' If Dir(sSavePath, vbDirectory) = "" Then ' MkDir (sSavePath) ' DoEvents ' End If
pRSet.Fields(hypl).Value = CStr(pRSet![Код].Value) & "#" & sSavePath & "#" Else ExitDo EndIf
pRSet.MovePrevious DoEvents LoopWhileNot pRSet.BOF
Итак, возвращаясь к нашим баранам.. Была задача - перенести данные из файла Excel в таблицу Access, для новых записей создать папки, и проставить на них гиперссылки. Имена папок формируются из поля Код(счетчик). Проблема возникла с индексированным полем. Если в нем случайно оказыватся значение, имеющееся в таблице (ткнула девочка шаловливым пальчиком не в ту кнопку), возникают проблемы... Сделал, как советовал Сергей, на словаре (ибо ближе и понятней). Но, с большим удовольствием, изучу альтернативное решение.
' Dim pCon As New ADODB.Connection, pRSet As New ADODB.Recordset Dim pCon AsObject, pRSet AsObject Dim vData AsVariant, vvData AsVariant Dim k AsLong, i AsLong, j& Dim strCon$, ctrSQL$, strFields$, strF$ Dim sSavePath$ Dim oDic AsObject Dim inexColumn&, errCounter&
Set oDic = CreateObject("Scripting.Dictionary") Set pCon = CreateObject("ADODB.Connection") Set pRSet = CreateObject("ADODB.Recordset")
pCon.CursorLocation = 3' adUseClient
Do'While Not pRSet.EOF
oDic.Item(pRSet.Fields(pIndexName).Value) = oDic.Count
pRSet.MoveNext DoEvents LoopWhileNot pRSet.EOF
k = pRSet.Fields.Count - UBound(vData, 2)
For i = 2ToUBound(vData) IfNot oDic.Exists(vData(i, inexColumn)) Then
pRSet.AddNew For j = 1ToUBound(vData, 2)
pRSet(j + k - 1).Value = vData(i, j) ' код & гипер Next Else
errCounter = errCounter + 1 For j = 1ToUBound(vData, 2)
vvData(errCounter, j) = vData(i, j) Next EndIf Next
pRSet.UpdateBatch Do'While Not pRSet.BOF
If pRSet.EOF ThenExitDo
IfIsNull(pRSet.Fields(hypl).Value) Then
sSavePath = sSaveFolder & CStr(pRSet![Код].Value) ' If Dir(sSavePath, vbDirectory) = "" Then ' MkDir (sSavePath) ' DoEvents ' End If
pRSet.Fields(hypl).Value = CStr(pRSet![Код].Value) & "#" & sSavePath & "#" Else ExitDo EndIf
pRSet.MovePrevious DoEvents LoopWhileNot pRSet.BOF
Андрей, глубоко в код вникать нет времени, поэтому сделал собственный пример для обновления вставки с учётом того, что url при вставки не создашь (значение счётчика не известно, судя по формированию url в твоём примере), то обновление происходит дважды 1. Обновляются все поля записей с уже существующим полем с уникальным индексом. 2. Создаются записи с данными полей для которых не известно значение поля с уникальным индексом. 3. Обновляются все url, хотя по идее, нужны только те которые были вставлены.
Андрей, глубоко в код вникать нет времени, поэтому сделал собственный пример для обновления вставки с учётом того, что url при вставки не создашь (значение счётчика не известно, судя по формированию url в твоём примере), то обновление происходит дважды 1. Обновляются все поля записей с уже существующим полем с уникальным индексом. 2. Создаются записи с данными полей для которых не известно значение поля с уникальным индексом. 3. Обновляются все url, хотя по идее, нужны только те которые были вставлены.anvg
Андрей, можно даже чуть проще без шага 3, если для вставки в Access настроить триггер - пусть Access сам формирует url по новому fid. Конечно если базовая часть пути константа.
Андрей, можно даже чуть проще без шага 3, если для вставки в Access настроить триггер - пусть Access сам формирует url по новому fid. Конечно если базовая часть пути константа.anvg
Частные Истины, полуистины, крохи великого вопроса. И бормочет Ответчик вопросы сам себе, верные вопросы, которые никто не может понять. И как их понять? Чтобы правильно задать вопрос, нужно знать большую часть ответа. Р. Шекли "Верный вопрос"
если для вставки в Access настроить триггер - пусть Access сам формирует url по новому fid.
Все слова знакомые Ну в точности как "читаю и перевожу со словарем". Слова перевел, а как их в предложение не подставляй, смысла не добавляется.
Цитата
Частные Истины, полуистины, крохи великого вопроса. И бормочет Ответчик вопросы сам себе, верные вопросы, которые никто не может понять. И как их понять? Чтобы правильно задать вопрос, нужно знать большую часть ответа. Р. Шекли "Верный вопрос"