Execute SQL From Excel (VBA)

[Mechanic]

Hi,

This can be used to Fetch(to sheet/control)/Modify/Excute SQL's :rolleyes:

-Requires reference to Microsoft ActiveX Data Objects 2.8 Library
(I know a lot of would say can be done with Late binding but i perfer this)


Function SQLJuicer(strSQLString As String, strDataBaseAddress As String, Optional rngWhereToPasteRange As Range, Optional blnReturnListArrayInstead As Boolean = True) As Variant

Dim adoConnection As New ADODB.Connection
Dim adoRcdSource As New ADODB.Recordset
Dim strDBPath As String

On Error GoTo Errs:
strDBPath = strDataBaseAddress

adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDBPath

If UCase(Left(strSQLString, 6)) = "SELECT" Then
adoRcdSource.Open strSQLString, adoConnection, 3

If rngWhereToPasteRange Is Nothing And blnReturnListArrayInstead = True Then
If (adoRcdSource.BOF Or adoRcdSource.EOF) = False Then
SQLJuicer = adoRcdSource.GetRows
End If
ElseIf Not rngWhereToPasteRange And blnReturnListArrayInstead = False Then
With rngWhereToPasteRange
.ClearContents
.Cells(1).CopyFromRecordset adoRcdSource
adoRcdSource.Close
End With
End If
Else
adoConnection.Execute strSQLString
End If

GoTo NormalExit
Errs:
MsgBox Err.Description, vbCritical, "Error!"
Err.Clear: On Error GoTo 0: On Error GoTo -1

NormalExit:
Set adoConnection = Nothing
Set adoRcdSource = Nothing
strDBPath = vbNullString

End Function


To Load a List to List Box/Combo Box:


Me.ComboBox1.List = Application.Transpose(SQLJuicer("SELECT Name FROM Employee", "C:\Mydatabase.mdb", ,True))

To Execute A SQL:


Call SQLJuicer(YourSQLString,"C:\Mydatabase.mdb")

And to get data to a Range:


Call SQLJuicer(YourSQLString,"C:\Mydatabase.mdb",Worksheets("Sheet1").Range("A1"))

[Admin]

:cool:

[Rasm]

Mechanic
I want to get into the SQL statements - so this is very helpful.

Do you have code that shows how to add a new table as well as how to add fields and set the properties for the added fields.

[Mechanic]

Hi Rasm,

For that you have to pass a Create Table statement like:


Call SQLJuicer("Create Table Employee (Name TEXT(100), Address TEXT(255), Age Number)","C:\Mydatabase.mdb")

The above SQL will create a table named 'Employee' with 3 fields Name (Text),Address(Text),Age(Number) and similarly you can write 'AlterTable' statement to modify existing tables.

Hope this helps... MC

[Rasm]

Coool - I try that - thanks

[Excel Fox]

If you are using an Excel 2007 and Access 2007 combo, you should use the following connection string

"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDBPath & ";Jet OLEDB:Database Password=PWD;"

Where strDBPath is the variable that contains the path, and "PWD" is your password

[Mechanic]

;) Agree!

[S M C]

For Excel 2007 connections strings, try Connection strings for Excel 2007 (http://www.connectionstrings.com/excel-2007)

For other connection strings, visit http://www.connectionstrings.com/

[Excel Fox]

To run SQL from within Excel where a sheet can act as a database / table, use the modified version of Mechanic's SQLJuicer



Function SQLJuicer(strSQLString As String, strDataBaseAddress As String, Optional rngWhereToPasteRange As Range, Optional blnUsingAccessRDB As Boolean = True, Optional blnReturnListArrayInstead As Boolean = True) As Variant

Dim adoConnection As Object 'New ADODB.Connection
Dim adoRcdSource As Object 'New ADODB.Recordset
Dim strDBPath As String

Set adoConnection = CreateObject("ADODB.Connection")
Set adoRcdSource = CreateObject("ADODB.Recordset")
On Error GoTo Errs:
strDBPath = strDataBaseAddress

If blnUsingAccessRDB Then
'For Access DB
adoConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDBPath
Else
'For Excel DB
adoConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDBPath & "; Extended Properties=""Excel 12.0 Macro;HDR=YES"";"
End If

If UCase(Left(strSQLString, 6)) = "SELECT" Then
adoRcdSource.Open strSQLString, adoConnection, 3
If rngWhereToPasteRange Is Nothing And blnReturnListArrayInstead = True Then
If (adoRcdSource.BOF Or adoRcdSource.EOF) = False Then
SQLJuicer = adoRcdSource.GetRows
End If
ElseIf Not rngWhereToPasteRange And blnReturnListArrayInstead = False Then
With rngWhereToPasteRange
.ClearContents
.Cells(1).CopyFromRecordset adoRcdSource
adoRcdSource.Close
End With
ElseIf Not rngWhereToPasteRange Is Nothing Then
rngWhereToPasteRange.CopyFromRecordset adoRcdSource
End If
Else
adoConnection.Execute strSQLString
End If

GoTo NormalExit
Errs:
MsgBox Err.Description, vbCritical, "Error!"
Err.Clear: On Error GoTo 0: On Error GoTo -1

NormalExit:
Set adoConnection = Nothing
Set adoRcdSource = Nothing
strDBPath = vbNullString

End Function