Microsoft Query only allows Excel users to read data from databases, not edit it. The following Visual Basic scripts will provide this functionality. You must first create the database, in accordance with the below assumptions, and then create a link from it to the Excel file using Microsoft Query (Data->Get External Data->New Query; set up a New Data Source). After that, the Excel file and ODBC database should be completely linked.
This script assumes the following:
Each Excel worksheet should have the following script (in the sheet's Visual Basic file):
Dim isWorking As Boolean ' Assumptions: ' -Table is Table1 ' -ID is (primary key, or at least indexed) AUTO_NUMBER (not null) and exists! ' -All other columns are TEXT (well, it doesn't really matter, but that's how I treat and create them) ' -No special features (sorry!) ' -You'll have to fix apostrophes (need to be written as \' because text in SQL is enclosed in single-quotes) ' -Only one QueryTable in the document (otherwise, alter "ActiveSheet.QueryTables(...)") ' -New entries are on the following line (or column) (otherwise they won't get erased, but it will work) ' -The user isn't malicious (things might get misplaced, or if the user is really malicious, BAD things could happen) ' -All cells in the worksheet are to be used for the database ' -Changes are done cellwise, not row- or column- wise (e.g. no pasting of rows, or deletion of rows, etc.) ' -Your text does not have the string "External" (case-sensitive) in it (creation of QueryTable involves a one-cell change of "ExternalData6"-type strings) Private Sub Worksheet_Change(ByVal Target As Excel.Range) If (Not isWorking) Then isWorking = True If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then If Not Target.Value Like "*External*" Then If (Target.Value Like "*'*") And Not (Target.Value Like "*\'*") Then MsgBox ("Must escape apostrophes (') with backslash (\) (i.e. \' not ')!") GoTo Skipped End If With ActiveSheet.QueryTables(ActiveSheet.QueryTables.Count) If .Refreshing Then .CancelRefresh End If .RefreshStyle = xlOverwriteCells If (Target.Row = 1) Then 'column titles If (.ResultRange.Columns.Count < Target.Column) Then If (Target.Value <> "") Then .Sql = "ALTER TABLE Table1 ADD COLUMN " & Target.Value & " TEXT" End If Else If (Target.Column <> 1) Then If (Target.Value = "") Then 'delete column Application.Undo If .Refreshing Then .CancelRefresh End If .Sql = "ALTER TABLE Table1 DROP COLUMN " & Cells(1, Target.Column) Else 'change column name Dim newName As String newName = Target.Value Application.Undo If .Refreshing Then .CancelRefresh End If .Sql = "ALTER TABLE Table1 CHANGE COLUMN " & Cells(1, Target.Column) & " " & newName & " TEXT" End If End If End If Else 'actual data If (.ResultRange.Columns.Count < Target.Column) Then 'col w/o name MsgBox ("Must give a name for new column first!") Else If (.ResultRange.Rows.Count - 1) >= (Target.Row - 1) Then 'existing record If (Target.Column = 1) Then 'tries to change ID If (Target.Value = "") Then 'delete record Application.Undo If .Refreshing Then .CancelRefresh End If .Sql = "DELETE FROM Table1 WHERE ID = " & Cells(Target.Row, 1) End If Else 'update record .Sql = "UPDATE Table1 SET " & Cells(1, Target.Column).Value & " = '" & Target.Value & "' WHERE ID = " & Cells(Target.Row, 1).Value End If Else 'create new record .Sql = "INSERT INTO Table1 VALUES (" & "NULL," Dim i As Integer i = 2 While i <= .ResultRange.Columns.Count 'create list of values (all but one null) If i = Target.Column Then .Sql = .Sql & "'" & Target.Value & "'," Else .Sql = .Sql & "''," End If i = i + 1 Wend .Sql = Left(.Sql, Len(.Sql) - 1) .Sql = .Sql & ")" End If End If End If .Refresh If .Refreshing Then .CancelRefresh End If .Sql = "select * from Table1 order by ID" .Refresh End With Skipped: End If End If isWorking = False End If End Sub
To initialize the Excel-ODBC link, run the following macro (or do it manually) once per sheet:
Sub initQuery() working = True With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=local", Destination:=Range("A1"), Sql:="SELECT* FROM Table1") .RefreshStyle = xlOverwriteCells .Refresh End With working = False End Sub
In "DSN=local", local should be replaced by the name of the ODBC data source (set up with Microsoft Query).
Copyright 2002 Mark Hammer. All rights reserved. You may modify this script at will, but please give me credit. I provide no guarantees or waranties whatsoever for this script. Questions, comments, etc. should be directed to firstname.lastname@example.org.