У меня есть Union Query в доступе с именем «Audit Query», и в этом запросе есть два параметра «Quarter» и «Last Name», я использую приведенный ниже код для передачи параметра в запрос, а затем выполняю запрос и удерживаю запись в переменной набора записей дает сообщение об ошибке.
"Неправильно определен объект параметра. Была предоставлена непоследовательная или неполная информация."
Когда я работаю в среде MS-Access, он работает нормально.
Sub LC_Test_Kashif()
'For this to work, you must goto Tools->Reference and select "Microsoft
Active X Data Objects x.xx Object Library" and "Microsoft Outlook XX.X
Object Library", otherwise VBA won't recognize the code
'Bring up logic checks for individual user
'Step 1: Declare your variables
Dim UserName As String
Dim LastName As String
Dim Quarter As Date
Dim LastRow As Long
Dim strMyPath As String, strDBName As String, strDB As String
Dim rsRecSet As ADODB.Recordset
dim strCon as adodb.connection
LastRow = Cells(Rows.Count, 1).END(xlUp).Row
LastName = Range("D2").Value
Quarter = Range("B2").Value
Dim cmdl As ADODB.Command
Set strCon = New ADODB.Connection
#If Win64 Then
strCon.Open "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=G:\Workflow Tools (Michael Cantor)\Tool For Fixing Bug From Michael Cantor\CDT PI Workload Report\QC Queries.mdb;Uid=Admin;Pwd="
#Else
strCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=G:\Workflow Tools (Michael Cantor)\Tool For Fixing Bug From Michael Cantor\CDT PI Workload Report\QC Queries.mdb"
#End If
'Create a new command object to process the stored proc
Set cmdl = New ADODB.Command
Set rsRecSet = New ADODB.Recordset
With cmdl
.ActiveConnection = strCon
'set COMMAND timeout property - query can time out on either the connection OR the command
.CommandTimeout = 4000
.CommandText = "Audit Query"
.CommandType = adCmdStoredProc
.Parameters.Refresh
.Parameters.Append .CreateParameter("Quarter", adVarChar, adParamInput, 100, Quarter)
.Parameters.Append .CreateParameter("Last Name", adVarChar, adParamInput, 100, LastName)
Set rsRecSet = .Execute() 'Error Line
End With
'Step 5: Clear previous contents
Sheets("Audits").Select
ActiveSheet.Range("A5:H1000").ClearContents
'Step 6: Copy and Sort the recordset to Excel
Sheets("Audits").Select
ActiveSheet.Range("A5:H1000").CopyFromRecordset MyRecordset
'Hide Rows
Dim c As Range
Dim LastRow1 As Long
LastRow1 = Cells(Rows.Count, 1).END(xlUp).Row
For Each c In Range("H5:H" & LastRow1).Cells
If c.Value <> "" And Range("F2").Value = "N" Then
c.EntireRow.Hidden = True
Else: c.EntireRow.Hidden = False
End If
Next c
ActiveSheet.Range("4:4").EntireRow.Hidden = False
End Sub
Заранее спасибо.
Спасибо
Kashif