Execute SQL SP in Excel VBA
- by TheOCD
HI
I am having problem with getting all the columns back when i execute following code in excel vba. I only get 6 out of 23 columns back.
Connection, command etc works fine (i can see exec command in the SQL Profiler), data headers are created for all 23 columns but i only get data for 6 column.
Side Note: it's not prod level code, have missed out error handling on purpose, sp works fine in SQL management studio, ASP.Net, C# win form app, it is for Excel 2003 connecting to SQL 2008.
Can someone help me troubleshoot it?
Dim connection As ADODB.connection
Dim recordset As ADODB.recordset
Dim command As ADODB.command
Dim strProcName As String 'Stored Procedure name
Dim strConn As String ' connection string.
Dim selectedVal As String
'Set ADODB requirements
Set connection = New ADODB.connection
Set recordset = New ADODB.recordset
Set command = New ADODB.command
If Workbooks("Book2.xls").MultiUserEditing = True Then
MsgBox "You do not have Exclusive access to the workbook at this time." & _
vbNewLine & "Please have all other users close the workbook and then try again.", vbOKOnly + vbExclamation
Exit Sub
Else
On Error Resume Next
ActiveWorkbook.ExclusiveAccess
'On Error GoTo No_Bugs
End If
'set the active sheet
Set oSht = Workbooks("Book2.xls").Sheets(1)
'get the connection string, if empty just exit
strConn = ConnectionString()
If strConn = "" Then
Exit Sub
End If
' selected value, if <NOTHING> just exit
selectedVal = selectedValue()
If selectedVal = "<NOTHING>" Then
Exit Sub
End If
If Not oSht Is Nothing Then
'Open database connection
connection.ConnectionString = strConn
connection.Open
' set command stuff.
command.ActiveConnection = connection
command.CommandText = "GetAlbumByName"
command.CommandType = adCmdStoredProc
command.Parameters.Refresh
command.Parameters(1).Value = selectedVal
'Execute stored procedure and return to a recordset
Set recordset = command.Execute()
If recordset.BOF = False And recordset.EOF = False Then
Sheets("Sheet2").[A1].CopyFromRecordset recordset
' Create headers and copy data
With Sheets("Sheet2")
For Column = 0 To recordset.Fields.Count - 1
.Cells(1, Column + 1).Value = recordset.Fields(Column).Name
Next
.Range(.Cells(1, 1), .Cells(1, recordset.Fields.Count)).Font.Bold = True
.Cells(2, 1).CopyFromRecordset recordset
End With
Else
MsgBox "b4 BOF or after EOF.", vbOKOnly + vbExclamation
End If
'Close database connection and clean up
If CBool(recordset.State And adStateOpen) = True Then recordset.Close
Set recordset = Nothing
If CBool(connection.State And adStateOpen) = True Then connection.Close
Set connection = Nothing
Else
MsgBox "oSheet2 is Nothing.", vbOKOnly + vbExclamation
End If
