Nicolas

' ***** frm_InstantSQL *****

Private Sub btn_fileSelect_Click()
    txt_fileSelect.Value = getFile()
End Sub

Private Sub btn_run_Click()
    Dim sourceFile As String, _
        queryString As String
    sourceFile = txt_fileSelect.Value
    queryString = txt_SqlQuery.Value
    runQuery sourceFile, queryString
End Sub

' ***** bas_InstantSQL *****

' To Do:
' * fix DEBUG flags
' * error handling?

' initialize form
Sub InstantSQL_init()
    Load frm_InstantSQL
    frm_InstantSQL.Show
End Sub

' run SQL query on Excel data
Sub runQuery(sourceFile As String, queryString As String)
    ' initialization
    Const DSN As String = "Excel-Dateien" ' DEBUG: DE only => i18n!?
    Const driverID As String = "790" ' Excel 97
    Const MaxBufferSize As String = "2048" ' DEBUG: ??
    Const PageTimeout As String = "5" ' DEBUG: ??
    Dim sourceDir As String
    sourceDir = getFolder(sourceFile)

    ' check source file
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(sourceFile) And fs.FolderExists(sourceDir) Then
       ' temporarily disable screen updating
       Application.ScreenUpdating = False
       ' empty active sheet
       ActiveSheet.Range("A1").Select
       ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Clear

       ' run query
       With ActiveSheet.QueryTables _
           .Add( _
               Connection:= _
                   "ODBC;" & _
                   "DSN=" & DSN & ";" & _
                   "DBQ=" & sourceDir & Application.PathSeparator & sourceFile & ";" & _
                   "DefaultDir=" & sourceDir & ";" & _
                   "DriverId=" & driverID & ";" & _
                   "MaxBufferSize=" & MaxBufferSize & ";" & _
                   "PageTimeout=" & PageTimeout & ";", _
               Destination:=ActiveSheet.Range("A1") _
           )
           .CommandText = Array(queryString)
           .Name = "Excel Data"
           .FieldNames = True
           .RowNumbers = False
           .FillAdjacentFormulas = False
           .BackgroundQuery = True
           .SavePassword = False
           .SaveData = True
           .AdjustColumnWidth = False
           .PreserveColumnInfo = True
           .PreserveFormatting = True
           .RefreshOnFileOpen = False
           .RefreshPeriod = 0
           .RefreshStyle = xlOverwriteCells
           .Refresh BackgroundQuery:=False
       End With

       ' re-enable screen updating
       ActiveSheet.Range("A1").Select
       Application.ScreenUpdating = True
    Else
        MsgBox "Error reading source file." & vbNewLine & "Aborting."
    End If
End Sub

' display file selection prompt
Function getFile()
    filePath = Application _
        .GetOpenFilename( _
            "Excel files (*.xls), *.xls," & _
            "All files (*.*), *.*" _
        )
    getFile = filePath
End Function

' retrieve base folder from file path
Function getFolder(filePath As String) ' DEBUG: inefficient/redundant!?
    Dim file As String, _
        path As String
    file = Dir(filePath)
    path = Left(filePath, Len(filePath) - (Len(file) + 1))
    getFolder = path
End Function