View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default is it POSSIBLE to create a Database in excel using VBA...

I wouiuld recommend using Access as the database if there are multiple users
rather than excel. You can create the database and retrieve data from Excel
and Excel VBA.

I set up two macros for somebody earlier this year where the Excel VBA
Create the database and uploaded the data. I then set up a query for the
person so that the data automatically downloaded everytime the workbook was
opened. it was also setup so that multiple people could simultaneously
access the data.

Below are 3 macros
1) Create database
2) Upload data to database
3) Create a query that will update everytime the workbook gets opened. this
macro only need to get run once.

Public Const Folder = "C:\Temp\"
Public Const FName = "submission.mdb"
Sub MakeDataBase()

Const DB_Text As Long = 10
Const FldLen As Integer = 40


strDB = Folder & FName

If Dir(strDB) < "" Then
MsgBox ("Database Exists - Exit Macro : " & strDB)
Exit Sub
End If

' Create new instance of Microsoft Access.
Set appAccess = CreateObject("Access.Application")
appAccess.Visible = True


' Open database in Microsoft Access window.
appAccess.NewCurrentDatabase strDB
' Get Database object variable.
Set dbs = appAccess.CurrentDb
' Create new table.
Set tdf = dbs.CreateTableDef("Submissions")

' Create Task/ID field in new table.
Set fld = tdf. _
CreateField("Task_ID", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Client Name field in new table.
Set fld = tdf. _
CreateField("Client Name", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Effective Date field in new table.
Set fld = tdf. _
CreateField("Effective Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Imp Mgr field in new table.
Set fld = tdf. _
CreateField("Imp Mgr", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Due Date field in new table.
Set fld = tdf. _
CreateField("Due Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Actual Date field in new table.
Set fld = tdf. _
CreateField("Actual Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Date Difference field in new table.
Set fld = tdf. _
CreateField("Date Difference", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

dbs.TableDefs.Append tdf

Set appAccess = Nothing


End Sub

Sub Submit()
'filename of database is with MakeDatabase macro

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

strDB = Folder & FName

If Dir(strDB) = "" Then
MsgBox ("Database Doesn't Exists, Create Database" & strDB)
MsgBox ("Exiting Macro")
Exit Sub
End If

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Folder & FName & ";" & _
"Mode=Share Deny None;"

cn.Open (ConnectStr)
With rs
.Open Source:="Submissions", _
ActiveConnection:=cn, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable

If .EOF < True Then
.MoveLast
End If
End With

With Sheets("Internal Project Plan")

ClientName = .Range("B4")
ImpMgr = .Range("B5")
LaunchDate = .Range("C4")

LastRow = .Range("K" & Rows.Count).End(xlUp).Row
For RowCount = 7 To LastRow

If UCase(.Range("K" & RowCount)) = "X" Then

DueDate = .Range("E" & RowCount)
ActualDate = .Range("F" & RowCount)
DateDif = .Range("M" & RowCount)
Accurate = .Range("L" & RowCount)
Task_ID = .Range("B" & RowCount)

With rs
.AddNew
!Task_ID = Task_ID
![Client Name] = ClientName
![Effective Date] = LaunchDate
![Imp Mgr] = ImpMgr
![Due Date] = DueDate
![Actual Date] = ActualDate
![Date Difference] = DateDif

.Update
End With
End If
Next RowCount

End With

Set appAccess = Nothing
End Sub

Sub CreateQuery()
'
' Macro4 Macro
' Macro recorded 1/19/2009 by Joel
'
strDB = Folder & "\" & FName
'
With ActiveSheet.QueryTables.Add(Connection:=Array(Arra y( _
"ODBC;DSN=MS Access Database;" & _
"DBQ=" & strDB & ";" & _
"DefaultDir=" & Folder & ";" & _
"DriverId=25;" & _
"FIL=MS Access;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"), _
Array(";")), Destination:=Range("A1"))

.CommandText = Array( _
"SELECT Submissions.Task_ID," & _
"Submissions.`Client Name`," & _
"Submissions.`Effective Date`," & _
"Submissions.`Imp Mgr`," & _
"Submissions.`Due Date`," & _
"Submissions.`Actual Date`," & _
"Submissions.`Date Difference`" & _
Chr(13) & "" & Chr(10) & _
"FROM `C:\temp\submission`.Submissions Submissions")
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub


"royUK" wrote:


You can create a simple database in Excel. All you really need is a
table set out with a header row. You should have no empty rows or
columns between data.

Excel even has an inbuilt Data Form. Select a cell in your table and
from the Data menu select Form.

Not sure what you wan to attach. If it is another workbook or document
then have a column in which you can store the path & file name, maybe
even as a hyperlink.

If you want to crate your own form there is an example here

'VBA Project Protection' (http://www.excel-it.com/vba_examples.htm)


--
royUK

Hope that helps, RoyUK
For tips & examples visit my 'web site' (http://www.excel-it.com/)
------------------------------------------------------------------------
royUK's Profile: http://www.thecodecage.com/forumz/member.php?userid=15
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=78909