Importing stored procedures into Excel with parameters
I have some visual basic code that populates an excel sheet with data from a
stored procedure. The procedure takes one date as parameter. You should
extend to two. Data from stored procedure goes into a recordset RS. RS is
then printed from line 6 in an excel worksheet.
Private Sub ButtonShowData_Click()
On Error GoTo Errhandler
If IsNull(Me.txtDateReport) Then
MsgBox ("You have to select a date")
Exit Sub
End If
'Prepare date to a string that sql server can understand
'Make date format independent of settings in control panel regional settings
'Control txtDateReport is formatted as date in accordance with regional
settitings
'Add leading zero to day and month if they are only one digit:
Dim StrDate As String, StrMonth As String, StrDay As String
StrMonth = Month(Me.txtDateReport.Value)
If Len(StrMonth) = 1 Then
StrMonth = "0" + StrMonth
End If
StrDay = Day(Me.txtDateReport)
If Len(StrDay) = 1 Then
StrDay = "0" + StrDay
End If
StrDate = Year(Date) & "/" & StrMonth & "/" + StrDay
Dim Wbook As Workbook
Dim wsSheet1 As Worksheet
Set Wbook = ThisWorkbook
Set wsSheet1 = Wbook.Worksheets.Item("Sheet5") 'Name of sheet where data
is printed
wsSheet1.Unprotect
wsSheet1.Range("A6").CurrentRegion.Clear
Dim Cnxn As New ADODB.Connection, strCnxn As String, CMD As New
ADODB.Command, PDate As New ADODB.Parameter, RS As ADODB.Recordset
'set up connection string for your own server, here is mine:
strCnxn = "Provider='sqloledb.1';Data Source='tns-server;" & _
"Initial Catalog='Lenovo'; Persist Security info='TRUE';User
ID='TestUser'; Password='TestUser'"
Cnxn.Open strCnxn
Set CMD.ActiveConnection = Cnxn
CMD.CommandType = adCmdStoredProc
CMD.CommandText = "LSP_MonthlyReport"
Set PDate = CMD.CreateParameter("Date", adVarChar, adParamInput, 20,
StrDate)
CMD.Parameters.Append PDate
Set RS = New ADODB.Recordset
Set RS = CMD.Execute
'Set column names on worksheet in line 5:
Dim Ctr As Integer
For Ctr = 0 To RS.Fields.Count - 1
wsSheet1.Cells(5, 1 + Ctr).Value = RS.Fields(Ctr).Name
Next Ctr
'Copy all data from recordset into excel worksheet from cells(6,1) (A6):
With wsSheet1
.Cells(6, 1).CopyFromRecordset RS
End With
RS.Close
Set RS = Nothing
Application.EnableEvents = True
Exit Sub
Errhandler:
End Sub
|