在使用 Excel Vba 导出带有计算字段的 Msaccess 查询 Table 时是否有任何解决方法?

Is There Any Work Around In Exporting Msaccess Query Table With Calculated Field Using Excel Vba Ado?

嗨,我有一个计算查询 Table name DataQuery like

日期/RJournal/AMount

其中 Rjournal 是计算字段

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

而且效果很好。

但是因为 MS Access 是我的数据库,Excel 是我的前端,我的大多数用户都是 excel 用户。我创建了一个导出按钮,使用 excel 中的 ADO 将此查询导出到 excel。由于某种原因,Field RJournal 不会捕获它的数据,它只是留空

但是如果我使用访问菜单外部数据然后导出到 Excel 所有数据都将存在。

我想知道 ADO 是否支持导出计算的 Table 查询。

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

但结果是这样

日期/RJournal/AMount 01 / / 1000 02 / / 1000 03 / /1000 04 / /1500

在 MSAccess 查询中使用内部 Select 查询即可。

我进行了 3 table 次查询

Table 1 组成 日期 DV编号 收款人 金额

Table2 组成 参考期刊 DV编号 收款人

所以在 Table 3 日期 RJournal: (Select REFjournal From Table2 where Table1.DvNumber = Table2.DVnumber and 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 ADO VBA.

导出到 Excel 会非常慢