The files
demonstrates how to use SQL in Excel to:
create a database,
create a table and add data
to it,
select data from a table,
delete a table,
delete a database.
13-Mar-2011 Author's note: The demo files have been updated and both now
include a "Run All" procedure as a way of testing the overall functionality.
For the DAO file the procedure is BygDao_RunAll and for ADO it's
BygAdo_RunAll.You can find them either by inspecting the VBA code, or by
clicking on VBA in the sheet, "05_CodeNotes".
Below is a short overview of the
file and some of the code.
I have tried to make the code simple
so you can follow what I am trying to achieve and consequently
I have restricted error checking to a bare minimum. If you choose
to use this code in your own application, please remember that
more error checking will probably be required.
Where ever possible I have used
SQL code because it is widely known and more likely to make sense
to anyone who has had database experience and now wants to use
Excel as a front-end to an Access back-end. There are two cases,
in this demonstration, where SQL code can't be used.
Below are lists of SQL data definition
and manipulation commands.
Those in BLUE are covered in the workbook.
Data Definition
CREATE TABLE
CREATE INDEX
ALTER TABLE
CONSTRAINT DROP
Data Manipulation
SELECT SELECT … INTO INSERT INSERT … INTO UPDATE
DELETE
INNER JOIN
LEFT JOIN, RIGHT JOIN
PARAMETERS
UNION
CREATE TABLE
The first task is to create a database.
I use two routines: "CreateADatabase" to do the donkey
work, and "CreateDb" as a cover which can be used anywhere
in your code.
(Please note: these examples are from the DAO workbook)
Sub CreateDb()
'' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'' Purpose : Cover to create an Access database
'' Written : 20-Oct-1999 by Andy Wiggins, BygSoftware.com
'' Revised : 11-Nov-2010 by Andy Wiggins, BygSoftware.com
''
Dim lStr_Db As String
lStr_Db = ThisWorkbook.Path & Application.PathSeparator & gConStr_Db & ".mdb"
'' Test for the demo database's existance
If Len(Dir(lStr_Db)) > 0 Then
'' If the database already exists, we don't need to create it
Else
'' Otherwise, create it
CreateADatabase lStr_Db
End If
End Sub
Sub CreateADatabase(aStr_DbName As String)
'' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'' Purpose : Create an Access database
'' Written : 03-Jul-1997 by Andy Wiggins, BygSoftware.com
''
Dim lObj_Dbs As Database
Dim lStr_Message As String
On Error GoTo ErrorHandler
'' See "CreateDatabase Method" in help for available options
Set lObj_Dbs = Workspaces(0).CreateDatabase(aStr_DbName, dbLangGeneral, dbVersion30) 'dbVersion20) for Jet v2
Set lObj_Dbs = Nothing
Exit Sub
ErrorHandler:
lStr_Message = "Database creation error"
lStr_Message = lStr_Message & _
Chr(10) & _
Chr(10) & "Error Number: " & Err & _
Chr(10) & "Error Description: " & Error()
MsgBox lStr_Message, vbInformation, gConStr_Byg
End Sub
INSERT
This routine does a lot of work.
It opens the database so it is ready to receive new data, creates
a new table, copies the data from an Excel range into the table,
and closes the database.
Sub CreateTableAndAddData()
'' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'' Purpose : Create a table from a range on a sheet
'' Written : 19-Oct-1999 by Andy Wiggins, BygSoftware.com
''
Dim lObj_Dbs As Database
Dim lLng_Cols As Long
Dim lLng_Rows As Long
Dim lLng_Count As Long
Dim lLng_RCount As Long
Dim lStr_WrapChar As String
Dim lStr_Sql As String
Dim lStr_Message As String
On Error GoTo ErrorHandler
ThisWorkbook.Activate
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Open the database
Set lObj_Dbs = OpenDatabase(ThisWorkbook.Path & Application.PathSeparator & gConStr_Db)
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Go to the top left corner of the range
Application.GoTo reference:=Range("rtlData")
''Get some info about the range
With ActiveCell.CurrentRegion
lLng_Cols = .Columns.Count
lLng_Rows = .Rows.Count
End With
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Ensure the target table does not exist - careful, there's no recovery
'' if you delete a table that you wanted.
'' This users an error-handling routine to check for the table's existance
On Error Resume Next
lStr_Sql = ""
lStr_Sql = lStr_Sql & " DROP TABLE " & gConStr_Sheet
lObj_Dbs.Execute lStr_Sql
On Error GoTo ErrorHandler
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Create the table
'' Go to the top left cell in the current range
ActiveCell.CurrentRegion.Cells(1, 1).Select
lStr_Sql = ""
lStr_Sql = lStr_Sql & " CREATE TABLE " & gConStr_Sheet & " ("
'' Loop around each column to create the SQL code
'' Column names must not contain spaces
With ActiveCell.CurrentRegion
For lLng_Count = 1 To lLng_Cols
lStr_Sql = lStr_Sql & .Cells(1, lLng_Count) & "x " & fGetCellFormat(.Cells(2, lLng_Count))
If lLng_Count <> lLng_Cols Then
lStr_Sql = lStr_Sql & ", "
Else
lStr_Sql = lStr_Sql & ")"
End If
Next
End With
'' This has created the following SQL code ...
''CREATE TABLE DataSource
'' (Staff_Nox NUMBER,
'' Salaryx CURRENCY,
'' Namex TEXT,
'' Boolyx BIT,
'' Regionx NUMBER,
'' Datex DATETIME)
''.. which is exexcuted in the database
lObj_Dbs.Execute lStr_Sql
'' Note: I have concatenated an "x" to the field name to try
'' and avoid reserved word conflicts in Access, e.g., if
'' a column was called "Date"
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Insert data into the table
With ActiveCell.CurrentRegion
For lLng_RCount = 2 To lLng_Rows
lStr_Sql = ""
lStr_Sql = lStr_Sql & " INSERT INTO " & gConStr_Sheet
lStr_Sql = lStr_Sql & " VALUES ("
For lLng_Count = 1 To lLng_Cols
Select Case fGetCellFormat(.Cells(2, lLng_Count))
Case "TEXT"
lStr_WrapChar = """"
Case "DATETIME"
lStr_WrapChar = "#"
Case Else
lStr_WrapChar = ""
End Select
lStr_Sql = lStr_Sql & lStr_WrapChar & .Cells(lLng_RCount, lLng_Count) & lStr_WrapChar
If lLng_Count <> lLng_Cols Then
lStr_Sql = lStr_Sql & ","
Else
lStr_Sql = lStr_Sql & ")"
End If
Next
lObj_Dbs.Execute lStr_Sql
Next
End With
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Close and tidy up
lbTidy:
lObj_Dbs.Close
Set lObj_Dbs = Nothing
Exit Sub
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ErrorHandler:
lStr_Message = "Table and data creation error"
lStr_Message = lStr_Message & _
Chr(10) & _
Chr(10) & "Error Number: " & Err & _
Chr(10) & "Error Description: " & Error()
MsgBox lStr_Message, vbInformation, gConStr_Byg
Resume lbTidy
End Sub
SELECT
Sub SelectAndReturnRecords()
'' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'' Purpose : Select records from a table
'' Written : 19-Oct-1999 by Andy Wiggins, BygSoftware.com
''
Dim lObj_Dbs As Database
Dim lObj_Rs As Recordset
Dim lStr_Sql As String
Dim lLng_NumberOfRows As Long
On Error GoTo ErrorHandler
ThisWorkbook.Activate
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Open the database
Set lObj_Dbs = OpenDatabase(ThisWorkbook.Path & Application.PathSeparator & gConStr_Db)
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' The Execute method is valid only with action queries.
'' Select queries contain a SELECT statement and can return records - action queries do not.
lStr_Sql = ""
lStr_Sql = lStr_Sql & " SELECT * "
lStr_Sql = lStr_Sql & " FROM " & gConStr_Sheet
lStr_Sql = lStr_Sql & " WHERE Namex Like 'R*'"
Set lObj_Rs = lObj_Dbs.OpenRecordset(lStr_Sql)
With ThisWorkbook.Sheets(gConStr_Target)
With .Cells(1, 1)
.CurrentRegion.Clear
'' Copies the contents of a DAO Recordset object onto a worksheet
lLng_NumberOfRows = .CopyFromRecordset(lObj_Rs)
End With
End With
'' The number of rows returned, but ..
'' MsgBox lLng_NumberOfRows
'' .. here's an alternative
'' With lObj_Rs
'' .MoveFirst ''Ensure we are at the first record before we go into the loop
'' .MoveLast ''Access/Jet thing - go here before counting
'' fRecordCount = .RecordCount ''Count the number of records
'' End With
'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Close and tidy up
lbTidy:
lObj_Dbs.Close
Set lObj_Dbs = Nothing
Set lObj_Rs = Nothing
Exit Sub
Комментариев нет:
Отправить комментарий