Excel Addin for Database

:D If thought this might be helpful for someone. I have a very simple add in to be used in excel for those who might want to pull information from a database into excel without having to use microsoft query. This add in allows you to pull information it to the spreadsheet and refresh it as you need it. It is so easy and probably over looked as a option


-All you need to do is create a new module in a new spreadsheet
-Add ADO 2.5
-Copy the below code and paste into module. Make database
specific changes. Such as SQL, server connection and prompt name.
-Then Save spreadsheet as a addin.
-Then you can add this new add in into you spreadsheets as needed

I hope you can use this.


'*************************************************
'Code starts her
'*************************************************

'This is a excel add in module created by EUpchurc 10/2001
'This module opens a recordset using ADO against _
sometime of Server or database. Then takes the data and assigns it to the cell specified
Public cnBPCS As New ADODB.Connection 'Define Connection varible
Public strSQL As String 'SQL string
'Define Connection string to server
Private Const ConnectBPCS = "PROVIDER=MSDASQL;DRIVER=SQL Server;SERVER=Servername;UID=Username;PWD=password;DATABASE=DB;APP=Application;WSID= Workstation"
Public rSBPCS As New ADODB.Recordset 'Define Recordset variable

Public Function NewAddinName(RequestField As String)
Dim DataPulled
On Error GoTo ErrorHandler

'Check connections and If connections are _
already open then close them
If rSBPCS.State = 1 Then rSBPCS.Close
If cnBPCS.State = 1 Then cnBPCS.Close

'Set connection properties to not time out _
Set connection string to defined connection above
cnBPCS.CommandTimeout = 0
cnBPCS.ConnectionTimeout = 0
cnBPCS.ConnectionString = ConnectBPCS

'Open connection
If cnBPCS.State = 0 Then cnBPCS.Open

'Trim and upper case if case senstive criteria specified
RequestField = Trim(UCase(RequestField))

'SQL to run on database
strSQL = " Select Field1,Field2,Field3,Field4 FRom Table_Name Where Field1 = '" & RequestField & "'"

'Set ADo recordset properties and open using connection
rSBPCS.CursorLocation = adUseClient
rSBPCS.Open strSQL, cnBPCS, adOpenKeyset, adLockOptimistic

'Check to see if any results where found
If rSBPCS.EOF = True Then
'if no then return Nothing
DataPulled = "Nothing"
Else
'If data found then loop through entire recordset and creat a text string to return
DataPulled = ""
Do Until rSBPCS.EOF = True
DataPulled = DataPulled & " * " & Trim(rSBPCS(0)) & "," & Trim(rSBPCS(1)) & "," & Trim(rSBPCS(2)) & "," & Trim(rSBPCS(3))
'Move to next record
rSBPCS.MoveNext
Loop

End If

CleanUp:
'close all open connection and open recordsets
If cnBPCS.State = 1 Then cnBPCS.Close
If rSBPCS.State = 1 Then rSBPCS.Close

'Assign function value the new results found from QUERY
RequestField = DataPulled
Exit Function

'Error handler just shows error message if encountered
ErrorHandler:
MsgBox Error

End Function

'*********
'End of Code
'**********