Question

基本上我有这个代码，我得到一个错误3012查询已经存在。我能在这做什么？

Public Function KSMSTransferKSMS()
Dim bfile As String
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim myQueryName As String
Dim myExportFileName As String
Dim sqlString1 As String
Dim sqlString2 As String
Dim sqlString3 As String
Dim sqlString4 As String
Dim sqlString As String
Dim MyValue As Variant
Dim WarehouseCode As String
Dim Country As String
Dim CustomerAction As String
Dim rsExport As DAO.QueryDef
Dim Db As Database

'On Error GoTo Handler:

MyValue = InputBox("Account Name", "Enter Account Name")

Set dbs = CurrentDb

WarehouseCode = "w*"
Country = "US"
CustomerAction = ""

sqlString1 = "SELECT [Account Assignments Table].[Account #], [Account Assignments Table].[Account Name], [Post Sales RTM Known Shipper Table].[Company Name], [Post Sales RTM Known Shipper Table].Code, [Post Sales RTM Known Shipper Table].[Current Location Phone1], [Post Sales RTM Known Shipper Table].[Current Location Address1], [Post Sales RTM Known Shipper Table].[Current Location Address2], [Post Sales RTM Known Shipper Table].[Current Location Department/Floor], [Post Sales RTM Known Shipper Table].[Current Location City], [Post Sales RTM Known Shipper Table].[Current Location State/Province], [Post Sales RTM Known Shipper Table].[Current Location Zip/Postal Code], [Post Sales RTM Known Shipper Table].[Current Location Country], '" & CustomerAction & "' AS [Customer Action] "
sqlString2 = "FROM [Account Assignments Table] RIGHT JOIN [Post Sales RTM Known Shipper Table] ON [Account Assignments Table].[Account #] = [Post Sales RTM Known Shipper Table].[Account Number] "
sqlString3 = "GROUP BY [Account Assignments Table].[Account #], [Account Assignments Table].[Account Name], [Post Sales RTM Known Shipper Table].[Company Name], [Post Sales RTM Known Shipper Table].Code, [Post Sales RTM Known Shipper Table].[Current Location Phone1], [Post Sales RTM Known Shipper Table].[Current Location Address1], [Post Sales RTM Known Shipper Table].[Current Location Address2], [Post Sales RTM Known Shipper Table].[Current Location Department/Floor], [Post Sales RTM Known Shipper Table].[Current Location City], [Post Sales RTM Known Shipper Table].[Current Location State/Province], [Post Sales RTM Known Shipper Table].[Current Location Zip/Postal Code], [Post Sales RTM Known Shipper Table].[Current Location Country], '" & CustomerAction & "' "
sqlString4 = "HAVING ((([Account Assignments Table].[Account #]) Is Not Null) AND (([Account Assignments Table].[Account Name])='" & MyValue & "') AND (([Post Sales RTM Known Shipper Table].Code) Like '" & WarehouseCode & "') AND (([Post Sales RTM Known Shipper Table].[Current Location Country])='" & Country & "'))"
sqlString = sqlString1 & sqlString2 & sqlString3 & sqlString4

Set rs = dbs.OpenRecordset(sqlString)

bfile = "S:\_Reports\KSMS\Designated Letter\KSMS Designated Letter - "

Set rsExport = CurrentDb.CreateQueryDef("myExportQueryDef", sqlString)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "rsExport", bfile & Format(Date, "mm-dd-yyyy") & ".xls", False, _
    "KSMS Designated Letter"

CurrentDb.QueryDefs.Delete myExportQueryDef
Set Db = Nothing

Exit Function

我需要知道在当前的代码集中我需要做什么，我需要在哪些代码中放置使这个错误消失的地方。

Answer 1

您必须删除查询：CurrentDb.QueryDefs.Delete "myExportQueryDef"

但是，如果查询不存在会出错，那么可能需要首先检查查询是否存在的代码。一种方式：
If Not IsNull(DLookup("[Name]", "mySysObjects", "[Name]='myExportQueryDef'")) Then

不是删除和重新创建对象，而是更改其SQL属性。

Dim qd As QueryDef
Set qd = CurrentDb.QueryDef("myExportQueryDef")
...
qd.SQL = sqlString

除了定期更改数据库设计的代码外，我建议尽可能导出报告而不是查询。

Answer 2

由于您不是要更改查询的结构组件（即表，字段，连接），而是传递值，请考虑使用QueryDef paramaterization，这不需要重新创建查询。另外，参数化是所有数据库中编程行业的最佳实践，特别是因为您实际上接受了用户输入。一个聪明的黑客/用户可以Bobby Tables你并摧毁你的数据库或检索机密信息！再加上这种方法，无需担心引号或连接VBA字符串。

由于您需要通过参数值导出到Excel的数据，请考虑创建定期删除和创建的临时表。是的，这比查询丢弃/创建稍微开销，但可以说更安全。下面是定义占位符参数的存储查询的SQL语法，然后在分配querydef后在VBA中，将VBA值绑定到占位符。

SQL 生成表操作查询（仅保存查询一次;表别名用于较少冗长的代码）

PARAMETERS CustomerActionParam Text(255), AccountNameValue TEXT(255), 
           WarehouseParam TEXT(255), CountryParam TEXT(255);
SELECT a.[Account #], a.[Account Name], p.[Company Name], p.Code, 
       p.[Current Location Phone1], p.[Current Location Address1], 
       p.[Current Location Address2], p.[Current Location Department/Floor], 
       p.[Current Location City], p.[Current Location State/Province], 
       p.[Current Location Zip/Postal Code], p.[Current Location Country], 
       [CustomerActionParam] AS [Customer Action] 
INTO mytmpTable

FROM [Account Assignments Table] a 
RIGHT JOIN [Post Sales RTM Known Shipper Table] p ON a.[Account #] = p.[Account Number] 

WHERE (((a.[Account #]) Is Not Null) AND ((a.[Account Name])= [AccountNameValue]) 
   AND ((p.Code) Like [WarehouseParam]) AND ((p.[Current Location Country])=[CountryParam]))

GROUP BY a.[Account #], a.[Account Name], p.[Company Name], p.Code, 
         p.[Current Location Phone1], p.[Current Location Address1], 
         p.[Current Location Address2], p.[Current Location Department/Floor], 
         p.[Current Location City], p.[Current Location State/Province], 
         p.[Current Location Zip/Postal Code], p.[Current Location Country], 
         [CustomerActionParam]

VBA （分配Querydef和绑定参数）

Dim dbs As Database
Dim tbldef As TableDef, qdef As QueryDef

Set dbs = CurrentDb

' DELETE TEMP TABLE IF EXISTS
For Each tbldef in dbs.TableDefs
   If tbldef.Name = "myTempTable" then
      dbs.Execute "DROP TABLE myTempTable", dbFailOnError
   End if
Next tbldef

MyValue = InputBox("Account Name", "Enter Account Name")

' ASSIGN SAVED QUERY
Set qdef = dbs.QueryDefs("myQuery")

' BIND PARAMETERS
qdef!CustomerActionParam = ""
qdef!AccountNameValue = MyValue
qdef!WarehouseParam = "w*"
qdef!CountryParam = "US"

' EXECUTE ACTION TO CREATE TEMP TABLE
qdef.Execute dbFailOnError

' EXPORT TEMP TABLE TO EXCEL
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myTempTable", _
    bfile & Format(Date, "mm-dd-yyyy") & ".xls", False, "KSMS Designated Letter"

Set tbldef = Nothing: Set qdef = Nothing
Set dbs = Nothing

错误3012访问vba

2 个答案: