在设计视图中打开查询,编辑,然后拉取结果

时间:2018-04-24 16:45:58

标签: vba access-vba ms-access-2010

只是想知道是否有人可以帮我解决这个问题。我在Excel中创建一个宏,在设计视图中打开一个查询,以便我可以编辑它。然后运行查询并拉入结果。不幸的是,我一直收到错误,说这个记录集是不可编辑的。代码如下。

'connect to Access Database
Application.StatusBar = "Connecting to Access database..."
Const DbLoc As String = "I:\Ben\New Stores\Reports\Scratch Reporting DB.accdb"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim recCount As Long
Set db = OpenDatabase(DbLoc)
Set objAccess = CreateObject("Access.Application")
With objAccess
    .opencurrentdatabase (DbLoc)
    .docmd.openquery "OOS by DC5"
    .docmd.openquery "Today2"
    .docmd.openquery "Today2_intrans"
    .docmd.openquery "Today7"
    .docmd.openquery "Today7_InTrans"
    .docmd.openquery "OOS by Dept_Final", acViewDesign
End With

Set rs1 = db.OpenRecordset("OOS by DC5", dbOpenSnapshot)
Set rs2 = db.OpenRecordset("Today7_InTrans", dbOpenSnapshot)
Set rs3 = db.OpenRecordset("Today7", dbOpenSnapshot)
Set rs4 = db.OpenRecordset("OOS by Dept_Final", dbOpenSnapshot)

'copy recordset to spreadsheet
Application.StatusBar = "Writing Access data to spreadsheet..."
If rs1.RecordCount = 0 Then
MsgBox "No data retrieved from database", vbInformation + vbOKOnly, "No Data"
GoTo Subexit
Else
rs1.MoveLast
recCount = rs1.RecordCount
rs1.MoveFirst
End If
ws11.Range("A1").CopyFromRecordset rs1
ws11.Range("B" & recCount + 1).Formula = "=SUM(B1:B" & recCount & ")"
ws11.Range("C" & recCount + 1).Formula = "=SUM(C1:C" & recCount & ")"
ws18.Range("A1").CopyFromRecordset rs2
ws19.Range("A1").CopyFromRecordset rs3
ws8.Range("A1").CopyFromRecordset rs4

请注意;这是整个宏的片段,所以我的变量不在这里声明。提前谢谢你的帮助!

SQL BEFORE

SELECT [OOS by Dept2].MaxOfDept, [dept name].[Department Name], [OOS by Dept2].[17935] AS Expr1, [OOS by Dept2].[18363] AS Expr2, [OOS by Dept2].[18455], [OOS by Dept2].[18584] AS Expr3, [OOS by Dept2].[18593] AS Expr4, [OOS by Dept2].[18638] AS Expr5, [OOS by Dept2].[18649], [OOS by Dept2].[18695] AS Expr6, [OOS by Dept2].[18696], [OOS by Dept2].[18712], [OOS by Dept2].[18810] AS Expr7, [OOS by Dept2].[18919], [OOS by Dept2].[18990] AS Expr8, [OOS by Dept2].[19720]
FROM [OOS by Dept2] LEFT JOIN [dept name] ON [OOS by Dept2].MaxOfDept = [dept name].Dept
GROUP BY [OOS by Dept2].MaxOfDept, [dept name].[Department Name], [OOS by Dept2].[17935], [OOS by Dept2].[18363], [OOS by Dept2].[18455], [OOS by Dept2].[18584], [OOS by Dept2].[18593], [OOS by Dept2].[18638], [OOS by Dept2].[18649], [OOS by Dept2].[18695], [OOS by Dept2].[18696], [OOS by Dept2].[18712], [OOS by Dept2].[18810], [OOS by Dept2].[18919], [OOS by Dept2].[18990], [OOS by Dept2].[19720];

SQL AFTER

SELECT [OOS by Dept2].MaxOfDept, [dept name].[Department Name], [OOS by Dept2].[17052], [OOS by Dept2].[18220], [OOS by Dept2].[18272], [OOS by Dept2].[18455], [OOS by Dept2].[18614], [OOS by Dept2].[18633], [OOS by Dept2].[18645], [OOS by Dept2].[18649], [OOS by Dept2].[18696], [OOS by Dept2].[18712], [OOS by Dept2].[18919], [OOS by Dept2].[19720]
FROM [OOS by Dept2] LEFT JOIN [dept name] ON [OOS by Dept2].MaxOfDept = [dept name].Dept
GROUP BY [OOS by Dept2].MaxOfDept, [dept name].[Department Name], [OOS by Dept2].[17052], [OOS by Dept2].[18220], [OOS by Dept2].[18272], [OOS by Dept2].[18455], [OOS by Dept2].[18614], [OOS by Dept2].[18633], [OOS by Dept2].[18645], [OOS by Dept2].[18649], [OOS by Dept2].[18696], [OOS by Dept2].[18712], [OOS by Dept2].[18919], [OOS by Dept2].[19720];

SQL常量

SELECT [OOS by Dept2].MaxOfDept, [dept name].[Department Name]
FROM [OOS by Dept2] LEFT JOIN [dept name] ON [OOS by Dept2].MaxOfDept = [dept name].Dept
GROUP BY [OOS by Dept2].MaxOfDept, [dept name].[Department Name];

1 个答案:

答案 0 :(得分:1)

我觉得这样的事情对你有用

将这些行添加到声明的顶部

Const QDF_MODIFY    As String = "OOS by Dept_Final"

Const BASIC_FIELDS  As String = "SELECT dept2.MaxOfDept, deptname.[Department Name]<INSERT FIELDS> "
Const BASIC_SQL As String = "FROM [OOS by Dept2] AS dept2 LEFT JOIN [dept name] AS deptname ON dept2.MaxOfDept = deptname.Dept "
Const GROUPBY_FIELDS As String = "GROUP BY dept2.MaxOfDept, deptname.[Department Name] <INSERT FIELDS> "

将这些行添加到声明部分

' Add these lines to top
Dim qdf  As DAO.QueryDef
Dim qdf2 As DAO.QueryDef

Dim strNewFields As String
Dim strNewSQL As String
Dim iField  As Integer

删除此行

'.docmd.openquery "OOS by Dept_Final", acViewDesign

Ater End With 添加此代码以更改SQL

' Change these to Querydef qdf2 references
Set qdf2 = db.QueryDefs("OOS by Dept2")
' Zero based index - ignore first field MaxOfDept
For iField = 1 To qdf2.Fields.Count - 1
    strNewFields = strNewFields & ", dept2.[" & qdf2.Fields(iField).Name & "]"
Next
qdf2.Close

' Insert new fields and rebuild SQL
strNewSQL = Replace(BASIC_FIELDS, "<INSERT FIELDS>", strNewFields)
strNewSQL = strNewSQL & BASIC_SQL
strNewSQL = strNewSQL & Replace(GROUPBY_FIELDS, "<INSERT FIELDS>", strNewFields)
Debug.Print strNewFields

' Replace the SQL
Set qdf = db.QueryDefs(QDF_MODIFY)
qdf.SQL = strNewSQL
qdf.Close