Я пытаюсь запросить базу данных MySQL из VBA в Excel с помощью хранимой процедуры с некоторыми параметрами. Моя проблема в том, что я получаю максимум одну строку в моем наборе результатов (ADO). После нескольких часов поиска и устранения неисправностей я сдался. Я провел много исследований в Интернете (конечно, также по SO, так как кажется, что есть много связанных вопросов, но ни один из которых не является моим - насколько я видел). Я уже могу сообщить вам, что работает / не работает:
Я вижу много о DAO ResultSets, где rs.moveLast
не был вызван. Тем не менее, я использую набор результатов ADO, так что это не проблема.
Когда я использую SELECT * FROM some_table
, все работает нормально. Именно вызов StoredProcedure вызывает у меня головную боль. :)
переданные параметры действительны. Когда я меняю их, я вижу другой (и правильный) результат, хотя бы одну запись. (ИП также проверяет действительность и будет менять их, когда пусто). Я даже реализовал специальные хранимые процедуры Debug и таблицу журналов в базе данных для регистрации переданных параметров и способа их обработки. Там все хорошо.
когда я запускаю тот же SP вручную с теми же параметрами, я получаю 3 записи.
Я изменил CursorLocation
через объект ADODB.Connection
на adUseClient
, и я пробовал другие способы получения набора результатов (через метод ADODB.ResultSet.Open
, через объект ADODB.Connection
, через PreparedStatement). Результат остается прежним. CursorType
равно adOpenStatic
(С другим CursorType recordCount
даст мне -1).
Я проверил несколько наборов результатов (их не должно быть), и никаких лишних.
В попытке предоставить минимальный воспроизводимый пример я создал новый пример хранимой процедуры с некоторыми тестовыми данными, который дает мне точно такие же результаты (т. Е. Только одну строку таблицы, которую я получу, выполнив запрос в HeidySQL или MySQL Workbench):
например:
Когда я ввожу «S8» в B2 (без кавычек), я должен ожидать три строки - на новом листе в той же рабочей книге (в соответствии с набором данных, приведенным ниже, результат должен быть: {{S8, apple, red }, {S8, виноград, белый}, {S8, банан, желтый}}). Вместо этого я получаю только {S8, виноград, белый} - как ни странно, это будет средняя запись в обоих клиентах SQL?
Option Explicit
Enum enums 'necessary because of late binding
adUseClient = 3 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/cursorlocationenum?view=sqlallproducts-allversions
adCmdStoredProc = 4 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/commandtypeenum?view=sqlallproducts-allversions
adVarChar = 200 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/datatypeenum?view=sqlallproducts-allversions
adParamInput = 1 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/parameterdirectionenum?view=sqlallproducts-allversions
End Enum
Sub excelmysql()
Dim conn As Object
Dim spCommand As Object
Dim param1 As Object
Dim rs As Object
Set conn = CreateObject("ADODB.Connection")
Set spCommand = CreateObject("ADODB.Command")
Set param1 = CreateObject("ADODB.Parameter")
Set rs = CreateObject("ADODB.Recordset")
' conn.CursorLocation = adUseClient
conn.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver}" _
& ";SERVER=" & credentials.getServer _
& ";DATABASE=" & credentials.getDB _
& ";UID=" & credentials.getUsername _
& ";PWD=" & credentials.getPassword
' Set spCommand = New ADODB.Command
spCommand.Prepared = True
spCommand.CommandText = "`testProc`"
spCommand.CommandType = adCmdStoredProc
spCommand.CommandTimeout = 30
spCommand.ActiveConnection = conn
Set param1 = spCommand.CreateParameter("inputCode", adVarChar, adParamInput, 2, Range("B1").Value)
spCommand.Parameters.Append param1
Set rs = spCommand.Execute()
Sheets.Add
ActiveSheet.Range("A2").CopyFromRecordset rs
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
Чтобы завершить, вот мой SQL SP (который прекрасно работает):
Чтобы определить таблицу тестирования:
CREATE TABLE `testTable` (
`someCode` VARCHAR(2) NOT NULL COLLATE 'utf8mb4_general_ci',
`text` VARCHAR(50) NOT NULL COLLATE 'utf8mb4_general_ci',
`color` VARCHAR(50) NOT NULL COLLATE 'utf8mb4_general_ci'
)
COMMENT='testTable meant for testing'
COLLATE='utf8mb4_general_ci'
ENGINE=InnoDB
;
Для заполнения таблицы тестирования:
INSERT INTO db.`testTable`
(`someCode`, `text`, `color`)
VALUES
('S8', 'apple', 'red'),
('S8', 'banana', 'yellow'),
('PB', 'car', 'black'),
('S8', 'grapes', 'white'),
('TR', 'car', 'purple'),
('PB', 'car', 'orange');
и, наконец, добавить хранимую процедуру:
DELIMITER //
CREATE DEFINER=`admin`@`%` PROCEDURE `testProc`(IN `inputCode` VARCHAR(2))
LANGUAGE SQL
DETERMINISTIC
READS SQL DATA
SQL SECURITY DEFINER
COMMENT 'test procedure'
BEGIN
DECLARE validCode varchar(1);
SET validCode = IF((COALESCE(inputCode, '') = '') OR (inputCode = '0'), 'N', 'Y');
SELECT * FROM db.`testTable`
WHERE (`someCode` LIKE if(validCode = 'Y', inputCode, '%'))
ORDER BY `color` ASC;
END //
DELIMITER ;
Демоверсия
Я благодарен за любую помощь, так как я в растерянности.
Пожалуйста, найдите альтернативный способ получения строк (к сожалению, это не меняет результат):
Option Explicit
Enum enums 'necessary because of late binding
adUseClient = 3 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/cursorlocationenum?view=sqlallproducts-allversions
adOpenStatic = 3 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/cursortypeenum?view=sqlallproducts-allversions
adCmdStoredProc = 4 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/commandtypeenum?view=sqlallproducts-allversions
adVarChar = 200 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/datatypeenum?view=sqlallproducts-allversions
adParamInput = 1 'https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/parameterdirectionenum?view=sqlallproducts-allversions
End Enum
Sub excelmysql()
Dim conn As Object
Dim spCommand As Object
Dim param1 As Object
Dim rs As Object
Set conn = CreateObject("ADODB.Connection")
Set spCommand = CreateObject("ADODB.Command")
Set param1 = CreateObject("ADODB.Parameter")
Set rs = CreateObject("ADODB.Recordset")
conn.CursorLocation = adUseClient
conn.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver}" _
& ";SERVER=" & credentials.getServer _
& ";DATABASE=" & credentials.getDB _
& ";UID=" & credentials.getUsername _
& ";PWD=" & credentials.getPassword
' Set spCommand = New ADODB.Command
spCommand.Prepared = True
spCommand.CommandText = "`testProc`"
spCommand.CommandType = adCmdStoredProc
spCommand.CommandTimeout = 30
spCommand.ActiveConnection = conn
Set param1 = spCommand.CreateParameter("inputCode", adVarChar, adParamInput, 2, Range("B1").Value)
spCommand.Parameters.Append param1
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
On Error Resume Next
On Error GoTo 0
If (MsgBox("This will clear Sheet: ""test"" in the activeWorkbook if it exists. Do you wish to continue?", vbYesNoCancel + vbExclamation, "Delete Sheet test?") = vbYes) Then
Sheets("test").Delete
If Err <> 0 Then
Err.Clear
End If
Else
MsgBox "User cancelled execution. Please rename your sheet 'test' to something else if it exists and try again.", vbOKOnly + vbInformation, "Execution stopped"
conn.Close
Exit Sub
End If
Set rs = spCommand.Execute()
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "test"
Dim row As Long
Dim i As Long
row = 1
rs.moveLast
rs.moveFirst
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
If (row = 1) Then
Sheets("test").Cells(row, i + 1) = rs.Fields.Item(i).Name
Else
Sheets("test").Cells(row, i + 1) = rs.Fields.Item(i).Value
End If
Next
If (row > 1) Then
rs.moveNext
End If
row = row + 1
Loop
' ActiveSheet.Range("A2").CopyFromRecordset rs
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
Спасибо за ваше время!
Ура,
Нильс