Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Необходимо переписать макрос выгрузки из access в excel
 
#1
18.01.2020 12:58:39
Всем привет
Имеется файл Excel, в который из базы Access макросом копируется часть данных из нужной таблицы с необходимыми фильтрами.
Внизу кусок кода, который за это отвечает.

Проблемы, которые хочется решить:
1) Файл не работает на 64-разрядной версии (а хочется, чтобы работал)
2) Файл не работает на версии Excel выше 2013 года (а хочется, использовать последнюю версию Excel)
3) На некоторых компьютерах файл иногда зависает, когда база Access и файл Excel лежат на сетевом диске, а не на диске компьютера

Если попробовать поменять версию, на ту, которая не соответствует одному из параметров, то Excel выдает ошибку ODBC 1004 на предпоследней строке кода

Можно переделать полностью базу Access, т.к. я подозреваю, что она тоже не оптимальна, т.к. сделана лет 7 назад, только данные обновляются ежедневно
Можно полностью переписать код макроса.
Подскажите что лучше сделать или подскажите что лучше почитать, чтобы это сделать самостоятельно?)

Комментарии по коду: переменные MySource, MyTable, MySelection, MyFilter определяются выше
MySource - путь к текущей папке, где лежит файл Excel и база Access
MyTable - Таблица в базе Access
MySelection - Имя одного из столбцов таблицы
MyFilter - одно из значений, которое может встретиться в столбце MySelection

P.S. использовать PQ не предлагать, нужна именно выгрузка значений из базы Access, чтоб потом их обрабатывать формулами, которые неудобно использовать в умных таблицах.
Код
With Sheets("Лист1").Cells(1, 1).QueryTable
.Connection = "ODBC;DBQ=" & MySource & "\Base.mdb; Default Dir=" & MySource & _
";Driver={Microsoft Access Driver (*.mdb)};DriverId=25;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;" & _
"PageTimeout=5;ReadOnly=1;Safe Transactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"
.CommandText = Array( _
"SELECT ", _
"`Столбец1`, `Столбец2`,`Столбец3`" _
& Chr(13) & "" & Chr(10) & _
"FROM " & MyTable & Chr(13) & "" & Chr(10) & _
"WHERE (" & MySelection & "='" & MyFilter & "')" _
)
.Refresh BackgroundQuery:=False
End With
Изменено: BapuK - 18.01.2020 13:13:02
 
 
 
#2
18.01.2020 13:22:53
Доброе время суток
Цитата
BapuK написал:
что лучше почитать, чтобы это сделать самостоятельно?)
Access connection strings - прочитать и привести вашу строку подключения к современным версиям. :)
 
 
 
#3
19.01.2020 02:37:57
Андрей VG, если использовать ACE OLEDB 12.0 - это нормальные современные методы или есть что-то получше?

Нашел вот такой кусок кода:
Код
Private Sub Workbook_Open()Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
 
On Error GoTo Whoa
Set TargetRange = ActiveSheet.Range("A1")
 
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=T:\Tablica\TestMDB.mdb;" & _
              "Jet OLEDB:Database Password='****';"
 
Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT * FROM TEST2", cn, , , adCmdText
 
' Write the field names
For intColIndex = 0 To rs.Fields.Count - 1
    TargetRange.Offset(1 - 1, intColIndex).Value = rs.Fields(intColIndex).Name 'ori nie bylo -1
Next
 
' Write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs
 
LetsContinue:
 
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
On Error GoTo 0
Exit Sub
Whoa:
MsgBox "Error Description :" & Err.Description & vbCrLf & _
   "Error at line     :" & Erl & vbCrLf & _
   "Error Number      :" & Err.Number
Resume LetsContinue
End Sub
Изменено: BapuK - 19.01.2020 02:41:56
 
 
 
#4
19.01.2020 09:48:39
Цитата
BapuK написал:
ACE OLEDB 12.0 - это нормальные современные методы
Вполне, с Office 2007 ничего нового не появилось. Но, в вашем исходном коде было достаточно поменять
Цитата
BapuK написал:
Driver={Microsoft Access Driver (*.mdb)}
на
Код
Driver={Microsoft Access Driver (*.mdb, *.accdb)}
ODBC версию для новых версий Office (включая 64битные).
Изменено: Андрей VG - 19.01.2020 09:49:11
 
 
 
Страницы: 1
Наверх