Есть ли работа по экспорту таблицы запросов Msaccess с вычисляемым полем с помощью Excel Vba Ado?

Question

Привет, у меня есть имя таблицы вычисляемых запросов DataQuery, например

Дата / RJournal / AMount

, где Rjournal - это вычисляемое поле

Rjournal: DLookUp ("REFjournal","DV", "ChckID> 0 и Payee = '" & [Payee] & "' и Dvnumber =" & [Dvnumber] & "")

И это прекрасно работает.

Нопоскольку MS Access - это моя база данных, а Excel - мой интерфейс, и большинство моих пользователей - это пользователи Excel. Я создал кнопку экспорта, чтобы экспортировать этот запрос в Excel, используя ADO в Excel. По какой-то причине Field RJournal не собирает свои данные, он просто остается пустым

Но если я использую доступ к Внешним данным меню, то при экспорте в Excel будут присутствовать все данные.

Интересно, поддерживает ли ADO Экспорт? Запрос вычисляемой таблицы.

Private Sub Export_Click()

Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim SQL As String

'add error handling
On Error GoTo errHandler:
'Disable screen flickering.
Application.ScreenUpdating = False
'clear the values from the worksheet
Sheets("Data").Range("A2:C500000").ClearContents

'get the path to the database
dbPath = Sheets("Update Version").Range("b1").Value

Set cnn = New ADODB.Connection ' Initialise the collection class variable

'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

SQL = "SELECT * FROM DATAQUERY"

'Create the ADODB recordset object.

Set rs = New ADODB.Recordset 'assign memory to the recordset

'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rs.Open SQL, cnn

'Check if the recordset is empty.
If rs.EOF And rs.BOF Then
'Close the recordet and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"

Exit Sub
End If


'Write the reocrdset values in the sheet.
Sheets("DATA").Range("A2").CopyFromRecordset rs

'Close the recordset and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing

'Enable the screen.
Application.ScreenUpdating = True



'Inform the user that the macro was executed successfully.
MsgBox "Congratulation the data has been successfully Imported", vbInformation, "Import successful"
'error handler
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"

END SUB

Я ОЖИДАЮ ТОГО, КАК ЭТО ТАКОЕ

Дата / RJournal / AMount 01 / CRJ / 1000 02 / CDJ ​​/ 1000 03 / CRJ / 1000 04 / CRJ / 1500

НО ЗАКОНЧИВАЕТСЯ, КАК ЭТО

Дата / Журнал / Количество 01 / / 1000 02 / / 1000 03 / / 1000 04 / / 1500

Answer 1

Использование Inner Select Query In MSAccess Запросы выполнят эту работу.

Я сделал 3 запроса таблицы

Таблица 1 Состав даты Дата DVnumber Сумма получателя

Таблица2 Состав RefJournalDVnumber Payee

Итак, в таблице 3 Дата RJournal: (выберите REFjournal From Table2, где Table1.DvNumber = Table2.DVnumber и Table1.Payee = Table2.Payee) Сумма

или в соответствии с SQL

   SELECT Table1.Date, (Select REFjournal From Table2 where Table1.DvNumber = 
   Table2.DVnumber and Table1.Payee=Table2.Payee) as Rjournal, Table1.AMOUNT
   FROM Table1;

Единственный недостаток: он очень медленный, если экспортируется в Excel с помощью Excel ADO VBA.