在使用 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 会非常慢
嗨,我有一个计算查询 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 会非常慢