Рекомендации по выполнению сценария SQL с использованием VBA в Oracle База данных

Question

Вот что я пытаюсь сделать:

1. Взять SQL скрипт из листа (скрипт имеет комментарии и запросы)
2. Назначить его для строковой переменной с помощью значение диапазона ячеек (куда вставляются сценарии) из рабочего листа
3. Выполните сценарий, передав строковую переменную соединению ADODB, которое я сделал ранее в качестве набора записей
4. Вставьте результаты скрипт, выполненный в Oracle базе данных на новом листе

Пока что я достиг:

1. Соединение с базой данных прошло успешно
2. Я могу назначить значения диапазона для варианта, но не для строки (ошибка: несоответствие типов)
3. Если я изменю переменную на вариант, то я не смогу выполнить ее как набор записей. (Ошибка: аргументы имеют неправильный тип, находятся вне допустимого диапазона или конфликтуют друг с другом)

Я знаю, что подход, который я использую, не так прост, поэтому мне нужны предложения о том, как я может быть в состоянии достичь этого.

Private Sub RunValidation_Click()
Dim ws As Worksheet
Dim sheet As Variant
Dim StrSQL As Variant
Dim sheetnumber As Integer
Dim irow As Integer
Dim rs As ADODB.Recordset
Dim elementcount As Integer

Call OptimizeCode_Begin
Call Start_DBConnect

irow = ScriptExecutor.Range("A" & Rows.count).End(xlUp).row
elementcount = irow - 13

StrSQL = ScriptExecutor.Range("A14: A" & irow).Value


Set rs = New ADODB.Recordset
rs.Open StrSQL, cn, adOpenDynamic, adLockReadOnly, adCmdText

If Not rs.EOF Then
rs.MoveFirst
End If

i = 1
sheetnumber = Application.Sheets.count - i
Set ws = Sheets.Add(After:=Sheets(Sheets.count))
ws.name = "Extracts-" & sheetnumber

Sheets("Extracts-" & sheetnumber).Range("A2").CopyFromRecordset rs

rs.Close
Set rs = Nothing

End Sub

Answer 1

Я могу достичь вышеуказанного вопроса немного другим подходом. Единственным предварительным условием является то, что пользователь должен будет удалить комментарии из сценария.

Сценарий выглядит примерно так: Пример сценария .

и код такой следует:

Private Sub RunValidation_Click()
Dim ws As Worksheet
Dim sheet As Variant
Dim sheetnumber As Integer
Dim irow As Integer
Dim rs As ADODB.Recordset
Dim fld As ADODB.field
Dim elementcount As Integer
Dim sqlscript As Variant
Dim StrSQL As String
Dim commands As Variant
Dim cmd() As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim results As String
Dim rownum As Integer
Dim col As Integer

On Error GoTo UserForm_Initialize_Err

If ScriptExecutor.TextUser = vbNullString Then
    MsgBox ("Please enter User ID.")
    GoTo UserForm_Initialize_Exit
End If

If ScriptExecutor.TextPwd = vbNullString Then
    MsgBox ("Please enter Password.")
    GoTo UserForm_Initialize_Exit
End If

Call OptimizeCode_Begin
Call Start_DBConnect

' Figuring out the last row with data
irow = ScriptExecutor.Range("A" & Rows.count).End(xlUp).row
elementcount = irow - 13

' Assigning range to a Variant variable
sqlscript = ScriptExecutor.Range("A14: A" & irow).Value

'Converting into String
StrSQL = Join(Application.Transpose(sqlscript), vbCrLf)

' Break the script into semi-colon
commands = Split(StrSQL, ";")

' Transfer values from array with empty values to array with empty values in the end
ReDim cmd(0 To 0)
j = 0

For i = LBound(commands) To UBound(commands)
    If commands(i) <> "" Then
        j = j + 1
        cmd(UBound(cmd)) = commands(i)
        ReDim Preserve cmd(0 To UBound(cmd) + 1)
    End If
Next i

'remove that empty array field at the end
If UBound(cmd) > 0 Then
    ReDim Preserve cmd(0 To UBound(cmd) - 1)
End If


Set rs = New ADODB.Recordset

' Open new sheet to paste results
k = 2
sheetnumber = Application.Sheets.count - k
Set ws = Sheets.Add(After:=Sheets(Sheets.count))
ws.name = "Extracts-" & sheetnumber

' Copy results in new sheet with field names
rownum = 1
For i = LBound(cmd) To UBound(cmd)
rs.Open cmd(i), cn, adOpenDynamic, adLockOptimistic, adCmdText
rs.MoveFirst
    col = 1
    For Each fld In rs.Fields
    With ws.Cells(rownum, col)
    .Value = fld.name: .HorizontalAlignment = xlLeft: .VerticalAlignment = xlTop: .EntireColumn.AutoFit: .Font.Bold = True: .Borders.Color = vbBlack
    End With
    col = col + 1
    Next

    rownum = ws.Range("A" & Rows.count).End(xlUp).row + 1
    With ws.Range("A" & rownum)
    .CopyFromRecordset rs:
    .Borders.Color = vbBlack
    rownum = ws.Range("A" & Rows.count).End(xlUp).row + 2
    End With

rs.Close
Next

Set rs = Nothing

UserForm_Initialize_Exit:
On Error Resume Next
Call OptimizeCode_End
Call End_DBConnect

Exit Sub

UserForm_Initialize_Err:
MsgBox Err.number & vbCrLf & Err.Description, vbCritical, "Error!"

Resume UserForm_Initialize_Exit
End Sub

В данный момент это работает идеально, но я тестирую его с другим сценарием ios.

Answer 2

Попробуйте соединить каждую строку в диапазоне с помощью CRLF, чтобы создать строку. Массив, назначенный из диапазона, представляет собой один столбец с множеством строк. Для функции JOIN необходим массив из нескольких столбцов с одной строкой и, следовательно, функция транспонирования.

   Dim StrSQL As String, arLines As Variant
   arLines = ScriptExecutor.Range("A14: A" & irow).Value
   StrSQL = Join(Application.Transpose(arLines), vbCrLf)

Если вам нужно игнорировать --comments, включая те, что находятся в той же строке, что и оператор (и пустые строки), тогда создайте строка по одной строке за раз, вероятно, самый простой метод.

Dim cell As Range, sLine As String, StrSQL As String
With ScriptExecutor.Range("A14: A" & irow)
    For Each cell In .Cells
        sLine = Trim(cell.Value)

        ' remove any comments --
        i = InStr(1, sLine, "--", vbTextCompare)
        If i > 0 Then
             sLine = Left(sLine, i - 1)
        End If

        If len(sLine) = 0 Then
            ' skip blank lines
        Else
            If Len(StrSQL) > 0 Then sLine = vbCrLf & sLine
            StrSQL = StrSQL & sLine
        End If
    Next
End With
Debug.Print StrSQL

При наличии нескольких запросов в одном скрипте вы получаете несколько наборов записей, поэтому попробуйте использовать метод .nextRecordSet.

Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Extracts-" & sheetnumber

Set rs = oCon.Execute(sql)

iRow = 2
Do Until rs Is Nothing
    With ws
        .Range("A" & iRow).CopyFromRecordset rs
        iRow = .Range("A" & Rows.Count).End(xlUp).Row + 2
    End With
    Set rs = rs.nextRecordSet
Loop