Execute SQL From Excel (VBA)

[Mechanic]

Hi,

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

-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]

[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

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