Suggestions on How to execute SQL script using VBA in Oracle Database - excel

Question

Here is what I am trying to do:
Pick up SQL script from a worksheet(script has comments and queries)
Assign it to a string variable with the value of range of cells(where the scripts are pasted) from the worksheet
Execute the script by passing the string variable to ADODB connection I made before as a recordset
Paste the results of the script executed in the Oracle Database in a new sheet
So far what I have achieved:
Database connection was successful
I am able to assign the range values to a variant but not a string (Error: Type Mismatch)
If I change the variable to a variant then I am not able to execute it as a recordset.
(Error: arguments are of the wrong type, are out of acceptable range or are in conflict with one another)
I know the approach I am using is not that easy therefore I need suggestions on how I may be able to achieve this.
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

Try joining each row in the range with CRLF to create a string. The array assigned from the range is a single column with many rows. The JOIN function needs a single row many columns array hence the transpose function.
Dim StrSQL As String, arLines As Variant
arLines = ScriptExecutor.Range("A14: A" & irow).Value
StrSQL = Join(Application.Transpose(arLines), vbCrLf)
If you have to ignore the --comments including those on the same line as a statement (and the blank lines) then building the string one line at a time is probably the simplest method.
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
With multiple queries in the same script you get multiple record sets so try using .nextRecordSet method.
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

Answer 2

I am able to achieve the above question with a slightly different approach. The only precondition is that the user will have to remove the comments from the script.
The script looks something like this:
Sample Script.
and the code is as follows:
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
This seems to be working perfectly at the moment but I am testing it with different scenarios.