General discussion

Locked

Get data from some DB in XL

By bogdincescu ·
As an old Oracle developer, I had some trouble having to get the datadase data in Excel, like some end-users wished.
After much trouble, here's what I came up with, which may be used for accessing anykind of DB, provided you have the OLEDB Provider for it.

Attribute VB_Name = "dbaccess_2"
Sub ora_connect()
'connection_form.Show (vbModal)
MacORAData '"", "", ""
End Sub

Sub bd_query(p_rst As Recordset, p_sql As String, p_cellref As String, p_desterr)
Dim my_crt_cell As String
Dim my_crt_row As Integer
Dim my_crt_col As Integer
Range(p_cellref).Select
my_crt_row = ActiveCell.Row 'Row(p_refcell)
my_crt_col = ActiveCell.Column
On Error Resume Next
p_rst.Open p_sql
If Err.Number <> 0 Then
x_err = x_err & Err.Number & ":" & Err.Description & "; "
Err.Clear
Select Case UCase(desterr)
Case "NO"
x = 1
Case "M"
MsgBox x_err, vbExclamation + vbOKOnly, "Eroare executie procedura in baza de date!"
Case Else
Range(p_desterr).Select
If Err.Number <> 0 Then
MsgBox x_err, vbExclamation + vbOKOnly, "Eroare executie procedura in baza de date!"
Else
Selection.Cells(1, 1).Value = x_err
End If
End Select
Exit Sub
End If
On Error GoTo 0
If p_rst.EOF Then
p_rst.Close
Cells(my_crt_row, my_crt_col).Value = "No data found!"
Exit Sub
End If
p_rst.MoveFirst
Do While Not p_rst.EOF
For i = 0 To p_rst.Fields.Count - 1
Cells(my_crt_row, my_crt_col + i).Value = p_rst.Fields(i)
Next i
p_rst.MoveNext
my_crt_row = my_crt_row + 1
Loop
p_rst.Close
End Sub


Sub exec_ado_cmd(p_adocmd As ADODB.Command, p_text As String, p_desterr As String, _
Optional p_destparam As String, Optional p_dir As String, Optional p_in_out As String)
' run the ADO command p_adocmd with the text p_text
' p_desterr - 'NO' - don't do a thing, 'M' - message, otherways destination cell where the error is written
' p_destparam - destination where the command params are displayed, if U wish to display them
' p_dir - direction to display command params: if "H", then along a row, otherwise down the column
' p_in_out - if "I", then display also the in params, otherwise only the OUT and INOUT params
Dim x_err As String
p_adocmd.CommandText = p_text
Err.Clear
On Error Resume Next
p_adocmd.Execute
If Err.Number <> 0 Then
x_err = x_err & Err.Number & ":" & Err.Description & "; "
Err.Clear
Select Case UCase(desterr)
Case "NO"
x = 1
Case "M"
MsgBox x_err, vbExclamation + vbOKOnly, "Eroare executie procedura in baza de date!"
Case Else
Range(p_desterr).Select
If Err.Number <> 0 Then
MsgBox x_err, vbExclamation + vbOKOnly, "Eroare executie procedura in baza de date!"
Else
Selection.Cells(1, 1).Value = x_err
End If
End Select
End If
On Error GoTo 0
If p_adocmd.Parameters.Count < 1 Or IsEmpty(p_destparam) Or p_destparam = "" Then
Exit Sub 'nu are param de afisat, sau nu are range definit
End If
If IsEmpty(p_dir) Or p_dir = "" Then
p_dir = "O"
End If
' On Error Resume Next
Range(p_destparam).Select
If Err.Number <> 0 Then
Exit Sub
End If
crtrow = ActiveCell.Row
crtcol = ActiveCell.Column
On Error GoTo 0
For i = 0 To p_adocmd.Parameters.Count - 1
If ((p_adocmd.Parameters(i).Direction = adParamInputOutput _
Or p_adocmd.Parameters(i).Direction = adParamOutput) And p_in_out <> "I") _
Or p_in_out = "I" Then
Cells(crtrow, crtcol).Value = p_adocmd.Parameters(i).Value
If IsEmpty(p_dir) Or UCase(p_dir) <> "H" Then
crtrow = crtrow + 1
Else
crtcol = crtcol + 1
End If
End If
Next i
End Sub


Sub MacORAData()

Static p_userid As String
Static p_pass As String
Static p_source As String

'-- show the connection form where the user enters the username, password & connectstring
Conectform.Show
If Conectform.x_action <> 1 Then
Exit Sub
End If


' ADO connection opened using the data entered in the connection form
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
On Error Resume Next
cn.Open "Provider=MSDAORA.1;Password=" & Conectform.f_passw.Value & ";User ID=" & Conectform.f_user.Value & ";Data Source=" & Conectform.f_source.Value
If Err.Number <> 0 Then
MsgBox Err.Number & ": " & Err.Description, vbExclamation + vbOKOnly, "Eroare conectare baza de date!"
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0

Dim adocmd As ADODB.Command
Set adocmd = New ADODB.Command
Set adocmd.ActiveConnection = cn

Dim rst1 As ADODB.Recordset
Set rst1 = New ADODB.Recordset
Set rst1.ActiveConnection = cn

....

The sub bd_query could run a SQL select on any database and get the data into the given destination in Excel, provided the DB connection is opened and there's no syntax error in the SQL statement.

The sub exec_ado_cmd runs some stored procedure (can run any PL/SQL block on Oracle) and may display the params used.

You may see below the 2 subs that for connecting to the DB I won't hard-code the DB Name, username & password, nor use an ODC: that is for portability and for security reasons at the same time. If needed, you may also have OLEDB provider to be selected using a combo-box in the connect form.

Enjoy it!

This conversation is currently closed to new comments.

0 total posts (Page 1 of 1)  
| Thread display: Collapse - | Expand +

All Comments

Back to Software Forum
0 total posts (Page 1 of 1)  

Related Discussions

Related Forums