Fehler 3012 Zugriff vba

Question

Grundsätzlich habe ich diesen Code und ich bekomme einen Fehler 3012 Abfrage existiert bereits. Was kann ich hier machen?

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 

Ich muss wissen, was ich in dem aktuellen Satz von Code tun müssen, was Code, den ich in setzen müssen, wo dieser Fehler weg gehen.

Answer 1

Sie müßten die Abfrage löschen: CurrentDb.QueryDefs.Delete "myExportQueryDef"

jedoch, wenn die Abfrage nicht existiert, dass Fehler werden so möglicherweise Code will, die zuerst überprüft, ob die Abfrage vorhanden ist. Eine Möglichkeit:
If Not IsNull(DLookup("[Name]", "mySysObjects", "[Name]='myExportQueryDef'")) Then

Anstatt das Objekt zu löschen und neu zu erstellen, ändern Sie seine SQL-Eigenschaft.

Anstelle von Code, der routinemäßig das Design von db ändert, empfehle ich, einen Bericht anstelle einer Abfrage zu exportieren, wann immer dies möglich ist.

Answer 2

Da Sie die Strukturkomponenten (d. H. Tabellen, Felder, Joins) der Abfrage nicht ändern, aber Werte übergeben, sollten Sie die Verwendung von QueryDef paramaterization in Erwägung ziehen, die keine erneute Erstellung der Abfrage erfordert. Nebenbei, Parametrisierung ist eine Programmierindustrie Best Practice in allen Datenbanken und vor allem, da Sie tatsächlich Benutzereingaben aufnehmen. Ein cleverer, Hacker/Benutzer kann Bobby Tables Sie und Ihre Datenbank zerstören oder vertrauliche Informationen abrufen! Außerdem müssen Sie sich bei diesem Ansatz keine Gedanken über Anführungszeichen oder Verkettung von VBA-Strings machen.

Und da Daten, die nach Parameterwerten exportiert werden, in Excel benötigt werden, sollten Sie eine temporäre Tabelle erstellen, die regelmäßig gelöscht und erstellt wird. Ja, das ist etwas mehr Overhead als eine Abfrage drop/create, aber wohl sicherer. Im Folgenden finden Sie die SQL-Syntax für eine gespeicherte Abfrage, die Platzhalterparameter definiert. Anschließend binden Sie VBA-Werte nach Zuordnung von querydef an Platzhalter.

SQL Make-Table Aktionsabfrage (einmal Abfrage nur speichern; Tabellen-Aliases für weniger wortreich Code verwendet werden)

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 und binden Parameter zuweisen)

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